Light ROM 1/LIGHT-ROM 1 (Amiga Library Services)(1994).iso/ffdisks/d883.lha/BBBBS/BBBBS59.lha/rexx/BBBBS.baud

Text File | 1993-06-12 | 183KB | 6,636 lines

/* $VER: BBBBS.baud 5.9 © 1993 Richard Lee Stockton 11:24PM (12.6.93)
       - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -

       BBBBS.baud. A full-featured BBS in ARexx for Baudbandit
  based on 'Answer.baud'. Thanks to Greg Cunningham for BaudBandit!

   See Information/BBBBS.doc & rexx/bbsLOCAL.rexx for install info
*/

saypath='SYS:Utilities/Say'

copyright.=''
copyright.1=STRIP(SUBSTR(SOURCELINE(1),10))
copyright.2='
from Gramma Software 17730-15th NE Suite 223 Seattle WA 98155'
copyright.3='
ARexx portions of this software copyright 1990-93 Richard Lee Stockton'
copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'

/* If QuickSortPort not found then try to run setup.rexx */

IF ~SHOW('P','QuickSortPort') THEN CALL setup.rexx()
IF ~SHOW('P','QuickSortPort') THEN EXIT 666

IF SHOW('P','BBBBS') THEN
  DO
    SAY 'BBBBS is already running!'
    EXIT 0
  END
CALL OPENPORT('BBBBS')
CALL SETCLIP('BBS_version',copyright.1)
CALL SETCLIP('BBS_localfiles')
CALL SETCLIP('BBS_localusers')
CALL SETCLIP('BBS_interpret')
CALL SETCLIP('BBS_maint')
CALL SETCLIP('BBS_MESSAGE')
CALL SETCLIP('BBS_BROWSE')
CALL SETCLIP('BBS_MSGS')
CALL SETCLIP('BBS_QUIT')

/* try to trap everything */

OPTIONS RESULTS
OPTIONS FAILAT 999999
NUMERIC DIGITS 14
SIGNAL ON HALT
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E

PARSE VERSION . . cpu .
cpu=RIGHT(cpu,2)/10
IF cpu<1 THEN cpu=1
Status Vers
BB_VERS=RESULT
bm=50
IF RIGHT(BB_VERS,4)>1.59 THEN bm=25

dcd
IF RC=0 THEN Send 'ATH1\r'

bbsprefs.=0  /* start with all prefs OFF */
alpha.=''
logonflag=1
emailonline=-1
CALL zerovars()


/* TEXT - User data structure by line */

text.=''
text.1='   Full Name'
text.2='      Street'
text.3='City, ST Zip'
text.4=' Voice Phone'
text.5='    Password'
text.6='    Protocol'
text.7='LinesPerPage'
text.8=' Preferences'
text.9='    Computer'
text.10='   Interests'
text.11='Session Time'
text.12='FirstSession'
text.13='Last Session'
text.14='      UpLoad'
text.15='    Download'
text.16='   Last File'
text.17='Ratio  Email'
text.18='    Winnings'
text.19='       Usage'
text.20='       Level'
text.21='Exclude DIRS'
text.22='   Msgs Read'
text.23='   Msgs Writ'


name=''
CR='0D'x
LF='0A'x

SAY CR
SAY CENTER(copyright.1,75)||CR

CALL PRAGMA('W','N')
CALL config()
IF bbsprefs.15~=0 THEN
  CALL send2log('===== BBBBS started' DATE('W') DATE() TIME('C') '=====')

IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
  ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'

SAY CENTER(copyright.2,75)||CR

/* open printer? */
IF bbsprefs.3 THEN
  DO
    IF ~OPEN(p,'PRT:','W') THEN
      DO
        CALL send2log('failed to open printer.')
        bbsprefs.3=0
      END
  END

/* CALL PRAGMA('W','W')   <-- UN-COMMENT THIS LINE TO ENABLE REQUESTERS */
CALL colors(1)
Capture OFF
Timeout 120
SAY CENTER(copyright.3,75)||CR

excuses.=''
courtesy=''
courtesyflag=0
SAY CENTER(copyright.4,75)||CR
SAY CR
SAY CR
SAY '                      Setting up, please wait...'CR
SAY CR

msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' THEN BREAK
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
    END
    CALL CLOSE(f)
  END

dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' | EOF(f) THEN LEAVE i
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
    END
    CALL CLOSE(f)
  END
CALL loaduserlist()
SAY CR
SAY '          The larger the BBS gets, the longer it takes to setup...'CR
CALL loadfiles()
dcd
IF RC~=0 THEN
  DO
    SAY CR
    SAY '      If it seems to take forever, ask the sysop to try' pen3'Resident'def 'mode.'CR
  END
SAY CR
CALL set_grand()
CALL loadalpha()

dcd
IF RC=0 THEN
  DO
    logonflag=0
    SIGNAL DONE
  END

LOGON:
CALL checkdcd()
bps=0
SetMark 'CONNECT'
IF RC=1 THEN
  DO
    GetLine
    connectline=RESULT
    PARSE VAR connectline 'CONNECT'bps
    CALL STRIP(bps)
    DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
    END
    bps=LEFT(bps,i-1)
  END
IF bps<300 | bps>38400 THEN
  DO
    SetMark 'CARRIER'
    IF RC=1 THEN
      DO
        GetLine
        connectline=RESULT
        PARSE VAR connectline 'CARRIER'bps
        CALL STRIP(bps)
      END
    ELSE bps='000 '
  END
DO i=3 WHILE DATATYPE(SUBSTR(bps,i,1),'N')
END
bps=LEFT(bps,i-1)
SIGNAL ON BREAK_C
SIGNAL OFF BREAK_E
REMOTE ON
TimeOut 120
IF bps<300 THEN bps=getbaudrate()
IF bps>16800 THEN bps=getinput(1 0 'Please enter your modem to modem baudrate > ')
IF bps<300 THEN SIGNAL DONE
bps=bps%1
IF logonflag=0 THEN
  DO
    logonflag=1
    DO i=1 TO 7
      SAY '  'CR
    END
    DO i=1 TO 4
      SAY CENTER(copyright.i,75)||CR
    END
    CALL DELAY(150)
    CALL colors(1)
    SAY CR
    SAY CR
    SAY CR
  END

IF alpha.0='' THEN CALL loadalpha()

CALL TIME('R')

/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  DO
    nonstop=1
    arg=bbspath'BBS_TEXT/HELLO'
    CALL readlines(arg 1)
    CALL seelines(0)
    nonstop=0
  END
SAY CR

SAY 'Running on' BB_VERS 'at' bps 'baud. ' TIME('C') DATE('W') DATE()||CR
Stat 'Z'
CALL checkdcd()

/* Ask for name */
name=''
courtesy=''
Queue CR
DO count=1 TO 3
  name=getinput(1 0 'Please enter name: ')
  name=cleanstring(1':'name)
  IF name='NEW' THEN LEAVE count
  IF name~='' THEN
    DO
      IF FIND(userlist,name)>0 THEN LEAVE count
      IF FIND(exclusion,name)>0 THEN
        DO
          SAY 'Sorry, that is a reserved name.'CR
          name=''
          ITERATE count
        END
      CALL loadcourtesy()
      IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
        DO
          SAY CR
          SAY 'Welcome' name'!'CR
          SAY 'You will be automatically validated after you enter your user info.'CR
          SAY CR
          LEAVE count
        END
    END
  IF count<3 THEN SAY 'New Users please enter NEW to apply for validation.'CR
END
IF count>3 THEN SIGNAL DONE
CALL TIME('R')
logontime=TIME('C')
line=left(name,16,' ') 'logged in  at' time('C') date('W') date() 'at' bps 'baud'
CALL send2log(line)
CALL checkUser()
IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
  DO
    SAY CR
    SAY 'Please help us out by entering the following information.'CR
    CALL getbirth()
    SAY '   Thank you!'CR
  END
prevcaller=''
prevcaller=GETCLIP('BBS_lastcaller')
IF prevcaller~='' THEN CALL SETCLIP('BBS_prevcaller',prevcaller)
city=docity(data.3)
CALL SETCLIP('BBS_lastcaller',name city'  'TIME('C') DATE())
CALL SETCLIP('BBS_level',level)
CALL postuser(0)
CALL sound('LOGON')
Timeout maxidle         /* max idle time at prompts */

IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
  DO
    arg=bbspath'BBS_TEXT/BIRTHDAY'
    IF EXISTS(arg) THEN
      DO
        SAY CR
        CALL showtext(arg)
      END
    SAY CR
    SAY '***  Happy Birthday,' pen3||data.1||def', and many more!  ***'CR
    SAY CR
  END
SAY CR

/* Get current protocol */
Status Trans
protocol=RESULT

CALL bbsLOGON.baud(name level)
CALL sortlibraries()
IF FIND(data.8,'QUICK')>0 THEN
  DO
    logonflag=0
    CALL do_quick()
    logonflag=1
  END

/*
Opening Display after logon. Seen by all Users ONCE A DAY. It first
looks for a unique yearly data (ie, WELCOME.0704), then daily data
(ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile
*/

IF DATE('I')>lastondate THEN
  DO
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
    IF EXISTS(arg) THEN CALL showtext(arg)
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
    IF EXISTS(arg) THEN CALL showtext(arg)
    SAY CR
    arg=bbspath'BBS_TEXT/WELCOME'
    IF EXISTS(arg) THEN CALL showtext(arg)

/*
Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
Deletes any that are previous to "today"
*/

    untils.=''
    IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
      DO
        CALL QSORT(1,untils.0,untils)
        DO ui=1 TO untils.0
          IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
          ELSE
            DO
              SAY CR
              CALL showtext(untils.ui)
            END
        END
      END
    DROP untils.
  END

IF bbsprefs.1 & ~terseflag THEN
  DO
    IF doGrin()>3 THEN CALL waiting()
    IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
    IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
    IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
      DO
        IF EXISTS('RAM:TODAY') THEN
          DO
            finfo=STATEF('RAM:TODAY')
            IF WORD(finfo,5)~=DATE('I') THEN
              ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
          END
        ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
        IF EXISTS('RAM:TODAY') THEN
          DO
            CALL readlines('RAM:TODAY' 1)
            CALL seelines(0)
          END
      END
    SAY CR
  END

CALL readmail(0)
IF ~terseflag THEN
  DO
    IF level>sysoplevel THEN
      DO
        lstmail=WORD(data.17,3)
        IF ~DATATYPE(lstmail,'W') THEN lstmail=0
        IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN
          IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
        IF level<99 THEN
          DO
            SAY CR
            CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
          END
        SAY CR
        CALL showtext(bbspath'Lists/NEW_USERS')
      END
    CALL logonstats()
    CALL newinfo()
  END
CALL showmarked()
CALL setdir(libpath||dirs.1)
logonflag=0


/***** MAIN *****/

IF menu~='ALL' THEN menu='MAIN'

RESTART:
IF name='' | data.20='' | logonflag THEN SIGNAL LOGON  /* login was interrupted */
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

waitchar=''
string=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
  go=0
  DO WHILE(~go)
    IF waitchar='' | waitchar='?' THEN
      DO
        commands='cghiqsvwxyz!#,'
        IF level>0  THEN commands='abcdefghijlmnoprstuvwxyz!$#&+,.'
        IF level>sysoplevel THEN commands=commands'k%^()=;'
        IF level=99 THEN commands=commands'@~'
        commands=commands'?'
        IF menuflag | waitchar='?' | string='?' THEN
          DO
            opt='MENU'
            arg=''
            CALL postuser(1)
            CALL menus()
          END
        ELSE SAY pen3'COMMANDS:'def commands||CR
      END
    CALL showtime()
    line=''
    line=line||bak2' 'TIME('C')' 'def
    IF menu='ALL' | menu='FILE' THEN
      line=line pen3'FILE_LIBRARY:'plaindir||def
    ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
    ELSE line=line pen3'MAIN:'def
    IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
    PARSE VAR waitchar string' 'arg
    CALL checkdcd()
    nonstop=0
    string=UPPER(STRIP(string))
    IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT2
    waitchar=''
    warnings=0
    IF DATATYPE(string,'W') THEN
      DO
        dirnum=string
        CALL chdir2()
        CALL since()
      END
    IF string='QUICK' THEN CALL do_quick()
    IF LEFT(string,3)='+++' THEN string=''
    opt=left(string,1)
    IF opt='G' THEN
      DO
        IF getinput(1 1 pen3'Logoff? (nY) > 'def)='N' THEN opt='?'
      END
    go=1    /* check for access */
    IF POS(opt,UPPER(commands))=0 THEN go=0
  END
  CALL postuser(1)
  OPTIONS PROMPT 'Filename: '
  SELECT
    WHEN opt='A' THEN CALL showalpha()
    WHEN opt='B' THEN CALL browse()
    WHEN opt='C' THEN CALL editor('MAIL' sysop)
    WHEN opt='D' THEN CALL dload()
    WHEN opt='E' THEN CALL readmail(1)
    WHEN opt='F' THEN IF menu~='ALL' THEN menu='FILE'
    WHEN opt='H' THEN CALL help('MAIN')
    WHEN opt='I' THEN CALL information()
    WHEN opt='J' THEN CALL jump2rexx()
    WHEN opt='K' THEN CALL killuser()
    WHEN opt='L' THEN CALL list()
    WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
    WHEN opt='N' THEN CALL newfiles()
    WHEN opt='O' THEN CALL otheruser()
    WHEN opt='P' THEN CALL editor('MSG')
    WHEN opt='R' THEN CALL readmessages()
    WHEN opt='S' THEN CALL bbsSEARCH()
    WHEN opt='T' THEN CALL chpro()
    WHEN opt='U' THEN CALL uload(1)
    WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG')
    WHEN opt='W' THEN CALL showuserlist()
    WHEN opt='X' THEN CALL switchmenuflag()
    WHEN opt='Y' THEN CALL edituser()
    WHEN opt='Z' THEN CALL counts()
    WHEN opt='~' THEN CALL sysED(1)
    WHEN opt='!' THEN CALL yell()
    WHEN opt='@' THEN CALL shell()
    WHEN opt='#' THEN CALL switchcolors()
    WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
    WHEN opt='%' THEN CALL editnote()
    WHEN opt='^' THEN CALL readlogs()
    WHEN opt='&' THEN CALL profiles(1)
    WHEN opt='+' THEN CALL ext_dload()
    WHEN opt='(' THEN CALL filereport()
    WHEN opt=')' THEN CALL mailreport()
    WHEN opt='=' THEN CALL levelreport()
    WHEN opt=';' THEN CALL changename()
    WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
    WHEN opt='.' THEN IF menu~='ALL' THEN menu='MAIN'
    WHEN opt='?' THEN IF menuflag THEN CALL help('MAIN')
    OTHERWISE NOP
  END
END
SIGNAL LOGOUT
EXIT       /* an extra margin of safety */


/* FUNCTIONS */

cleanstring:
PARSE ARG nflag':'cstr
bot=TRIM(XRANGE(,' '))
bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
top=XRANGE('7F'x)
IF nflag=1 THEN
  DO
    bot=bot||XRANGE('!','@')'[\]`~{:}'
    cstr=TRANSLATE(UPPER(cstr),' ','_')
  END
cstr=COMPRESS(cstr,bot||top)
IF nflag~=2 THEN cstr=STRIP(cstr)
IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
RETURN cstr


showtext:
PARSE ARG arg .
IF EXISTS(arg) THEN
  DO
    CALL readlines(arg 1)
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
RETURN


doGrin:
IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
CALL setdir(bbspath'rexxDoors')
temp=Grin_du_Jour.rexx()
SAY CR
RETURN temp


send2log:
PARSE ARG sendline
logfile=bbspath'Logs/log.'DATE('S')    /* daily logs */
IF ~OPEN('log',logfile,'A') THEN
  DO
    IF ~OPEN('log',logfile,'W') THEN
      DO
        SAY 'failed to open log file'
        SIGNAL DONE
     END
  END
CALL WRITELN('log',sendline)
CALL CLOSE('log')
IF bbsprefs.3=1 THEN CALL WRITELN(p,sendline)
RETURN


send2last:
PARSE ARG sendline
IF name=sysop THEN RETURN   /* delete to have sysop in USER.LOG */
lynes.=''
lynes.0=2
lynes.1='        -'pen3 bbsname def'user log for the last 99 calls -'
lynes.2=sendline
logfile=bbspath'USAGE/USER.LOG'  /* simple usage log */
IF EXISTS(logfile) THEN
  DO
    x=OPEN(lu,logfile,'R')
    IF x=0 THEN RETURN
    CALL READLN(lu)
    DO i=3 TO 99
      sendline=READLN(lu)
      IF EOF(lu) THEN LEAVE i
      lynes.i=sendline
    END
    CALL CLOSE(lu)
    IF i>99 THEN lynes.0=99
    ELSE lynes.0=i-1
  END
x=OPEN(lu,logfile,'W')
IF x=0 THEN RETURN
DO i=1 TO lynes.0
  CALL WRITELN(lu,lynes.i)
END
CALL CLOSE(lu)
RETURN


do_quick:
IF FIND(UPPER(data.8),'QUICK')=0 THEN
  DO
    SAY 'The QUICK option is OFF in your current settings.'CR
    IF getinput(1 1 'Turn the QUICK option ON? (nY) >')='N' THEN RETURN
    data.8=data.8 'QUICK'
    CALL saveData(0)
  END
IF getinput(1 1 'Edit your QUICK exclude list? (Ny) >')='Y' THEN
  DO
    SAY CR
    SAY 'You may EXCLUDE any of these from your QUICK archives.'CR
    SAY pen3||LEFT('-',74,'-')||def||CR
    temp=LEFT(' ',7)
    SAY temp'HELLO          - Pre-logon message.'CR
    SAY temp'WELCOME        - Post-logon message.'CR
    SAY temp'GOODBYE        - Logoff message.'CR
    SAY temp'HOURLY         - Average-Minutes-Per-Hour usage graph.'CR
    SAY temp'STATS.BBS      - Most of the Z command from the main menu.'CR
    SAY temp'<filename>     - ANY file in the Information area.'CR
    SAY temp'MESSAGES       - New conference messages.'CR
    SAY temp'FILELIST       - New file descriptions.'CR
    SAY pen3||LEFT('-',74,'-')||def||CR
    SAY 'Enter a space separated list of what you wish to exclude.'CR
    SAY pen3'Exclude:'def data.26||CR
    temp=getinput(1 0 pen3'Exclude: 'def)
    IF temp='' & data.26~='' THEN
      DO
        IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
          data.26=''
      END
    ELSE data.26=temp
    temp='Your QUICK archives will exclude'pen3
    IF data.26='' THEN temp=temp 'nothing!'
    ELSE temp=temp data.26
    SAY temp||def||CR
    CALL saveData(0)
    SAY CR
  END
IF GETCLIP('BBS_'name)~='' THEN
  DO
    SAY CR
    SAY 'The QUICK routines are still working on your archive...'CR
    SAY 'Please try again later.'CR
    SAY CR
    RETURN
  END
quickdir=bbspath'EmailFiles/'name
CALL MAKEDIR(quickdir)
CALL setdir(quickdir)
IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) >')='Y' THEN
  DO
    arg='QUICKIN.lha'
    ul=2
    DO WHILE ul=2
      ul=uload(0)
    END
  END
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
  IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
    DO
      ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
      SAY CR
      SAY 'Processing QUICKIN archive...'CR
      SAY CR
    END
IF GETCLIP('BBS_'name)='QUICK' THEN
  DO
    SAY CR
    SAY 'The QUICK routines are still working on your file(s)...'CR
    SAY CR
    RETURN
  END
arg='RAM:dirlist'
ADDRESS COMMAND 'C:list >'arg quickdir'/QUICK_#? DATES'
IF WORD(STATEF(arg),2)>80 THEN
  DO
    CALL readlines(arg 1)
    CALL seelines(0)
    SAY CR
  END
efiles=UPPER(SHOWDIR(quickdir))
DO i=1 TO WORDS(efiles)
  arg=WORD(efiles,i)
  IF LEFT(arg,6)='QUICK_' & RIGHT(arg,4)='.LHA' THEN
    DO
      SAY arg 'is' WORD(STATEF(arg),2) 'bytes.'CR
      qarg=arg
      DO WHILE dload()=1
      END
      IF getinput(1 1 'Delete' qarg'? (nY) > ')~='N' THEN
        DO
          CALL DELETE(quickdir'/'qarg)
          CALL DELETE(quickdir'/'qarg'.xdl')
        END
    END
END
arg=''
SAY CR
IF GETCLIP('BBS_'name)~='' THEN RETURN
IF getinput(1 1 'Archive new BBS activity? (nY) > ')~='N' THEN
  DO
    CALL SETCLIP('BBS_city',city)
    CALL SETCLIP('BBS_'name'_26',data.26)
    IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
      CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      CALL SETCLIP('BBS_'name'_22',data.22)
    CALL MAKEDIR(bbspath'EmailFiles/'name)
    ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
    CALL send2log('Started QUICKOUT at' TIME('C'))
    SAY CR
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      DO
        clear_marked=1
        DO i=1 TO level
          IF WORD(data.22,i)~=-1 THEN
            lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
        END
        SAY CR
      END
    IF FIND(UPPER(data.26),'FILELIST')=0 THEN
      lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
    newfilesdate=DATE('S') TIME()
    IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
      DO
        DO i=1 TO libs.0
          CALL WRITELN(f,libs.i)
        END
        CALL CLOSE(f)
      END
    IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
      DO
        DO i=1 TO msgs.0
          CALL WRITELN(f,msgs.i)
        END
        CALL CLOSE(f)
      END
    SAY CR
    IF getinput(1 1 'Logoff Now? (nY) >')~='N' THEN
      DO
        SAY 'Your archive will be waiting next time you call...'CR
        SAY CR
        SIGNAL LOGOUT2
      END
    SAY 'You will be signaled if you are still online when your archive is ready...'CR
    CALL saveData(1)
  END
ELSE
  DO
    SAY CR
    IF getinput(1 1 'Logoff Now? (nY) >')~='N' THEN SIGNAL LOGOUT2
  END
SAY CR
RETURN


killuser:
IF level<=sysoplevel THEN RETURN
killcount=0
DO loop=1
  IF arg='' THEN
    DO
      OPTIONS PROMPT 'RETURN=QUIT  Username to Kill: '
      PULL arg
    END
  IF STRIP(arg)='' THEN LEAVE loop
  arg=UPPER(arg)
  arg=SPACE(STRIP(arg),1,'_')
  IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN
    DO
      arg=''
      ITERATE loop
    END
  SAY 'Working...'lineup||CR
  IF readlines(bbspath'Users/'arg 1) THEN
    DO
      SAY 'User' arg 'not found.'CR
      arg=''
      ITERATE loop
    END
  IF level<=lynes.20 THEN
    DO
      SAY '*** Tsk! Tsk!  Your level is not greater than' arg'.'CR
      CALL send2log('Tried to kill:' arg)
      arg=''
      ITERATE loop
    END
  CALL DELETE(bbspath'Users/'arg)
  IF EXISTS(bbspath'Email/'arg) THEN
    DO
      temp=WORDS(SHOWDIR(bbspath'Email/'arg))
      emailonline=emailonline-temp
      ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL'
    END
  IF EXISTS(bbspath'EmailFiles/'arg) THEN
    ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL'
  CALL send2log('Killed:' arg)
  SAY CR'User file, Email & EmailFiles for' arg 'have been deleted.'CR
  killcount=killcount+1
  arg=''
END
IF killcount=0 THEN RETURN
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
RETURN


menus:
CALL checkdcd()
SAY CR
IF menu='NEW' THEN
DO
  SAY pen6'     _________________'def||CR
  SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def||CR
  SAY pen6' |                        |'def||CR
  SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'I'def']nformation        'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
  SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
  SAY pen6' |________________________|'def||CR
END
ELSE IF menu='MSG' THEN
DO
    SAY pen6'       ____________'def||CR
    SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def||CR
    SAY pen6' |                       |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3';'def'] change username 'pen6'|'def||CR;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'~'def'] online editor   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def||CR
    SAY pen6' |_______________________|'def||CR
END
ELSE IF menu='FILE' THEN
DO
    SAY pen6'         _________'def||CR
    SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'A'def']lphabetic list    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'L'def']ist by Library    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'T'def']ransfer protocol  'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'+'def'] Extra Devices    'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3';'def'] change username  'pen6'|'def||CR;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def||CR;END
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
END
ELSE IF menu='MAIN' THEN
DO
    SAY pen6'       _____________'def||CR
    SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def||CR
    SAY pen6' |                        |'def||CR
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'&'def'] user profiles    'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def||CR
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def||CR
    SAY pen6' |________________________|'def||CR
END
ELSE IF menu='ALL' THEN
DO
    SAY pen6'     __________________________________________________________'def||CR
    SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def||CR
    SAY pen6' |                                                                |'def||CR
    SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'A'def']lphabetical list  ['pen3'P'def']ost messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'I'def']nformation        ['pen3'B'def']rowse filenotes   ['pen3'R'def']ead messages      'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics   ['pen3'L'def']ist by Library    ['pen3'E'def']mail (private)    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'N'def']ew files          ['pen3'C'def']omment to SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'D'def']ownload           ['pen3'!'def'] YELL for SYSOP   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'U'def']pload             ['pen3'X'def']pert (no menus)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'T'def']ransfer protocol  ['pen3'$'def'] toggle menu(s)   'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'&'def'] user profiles    ['pen3'+'def'] Extra Devices    ['pen3'#'def'] toggle colors    'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'V'def']iew user log      ['pen3','def'] hourly stats     'pen6'|'def||CR
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def||CR
    SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3';'def'] change username  'pen6'|'def||CR;END
IF(level=99) THEN
    SAY pen6' |'def' ['pen3'~'def'] online editor    ['pen3'@'def'] dos shell        ['pen3')'def'] email report     'pen6'|'def||CR
    SAY pen6' |________________________________________________________________|'def||CR
END
QUEUE CR  /* clears any un-CRed input in the queue */
RETURN


help:
ARG helppath .
SAY CR
SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'CR
IF helppath='MAIN' THEN
  SAY 'Commands available from the' pen3||menu||def 'menu:'CR
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend)
RETURN


waiting:
CALL checktime()
IF waitchar='Q' THEN
  DO
    waitchar=''
    RETURN
  END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3'                          RETURN=Continue 'def
PULL waitchar
CALL cleanline(1)
CALL checkdcd()
RETURN


waiting2:
CALL checktime()
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
IF waitchar='N' THEN
  DO
    nonstop=1
    SAY lineup||pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def||CR
    SAY CR
    CALL DELAY(100)
    waitchar=''
  END
CALL cleanline(1)
CALL checkdcd()
IF waitchar='Q' THEN RETURN 1
RETURN 0


cleanline:
ARG lflag .
IF colorflag~=1 & lflag=1 THEN RETURN
cline=lineup||LEFT(' ',78)
IF lflag=1 THEN cline=cline||lineup
SAY cline||CR
RETURN


getinput:
PARSE ARG upflag' 'oneflag' 'pline
CALL checkdcd()
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
inarg=cleanstring(0':'inarg)
RETURN inarg


docity:
PARSE ARG citi
citi=TRANSLATE(citi,'          ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
  IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)


postuser:
IF bbsprefs.12~=1 THEN RETURN
ARG upflag .
IF upflag=6 THEN ptext='Logoff:' DATE() TIME('C')'  'name city
ELSE IF upflag=7 THEN ptext=name'  is a NEW USER!'
ELSE ptext=name city'  On:' logontime'  Last On:' DATE(,lastondate,'I')
ptext=CENTER(ptext,74)'\'
age='?'
IF UPPER(WORD(data.12,3))='BIRTHDAY:' THEN
  DO
    IF DATATYPE(WORD(data.12,4),'W') THEN
      DO
        age=LEFT(DATE('S'),4)-LEFT(WORD(data.12,4),4)
        IF SUBSTR(DATE('S'),5,2)<SUBSTR(WORD(data.12,4),5,2) THEN age=age-1
      END
  END
IF age='?' & WORD(data.12,4)~='' THEN age=WORD(data.12,4)
ptext2='Baud:' bps'   Age:' age'   Usage:' data.19
IF chatrequest=1 THEN ptext2=ptext2' - CHAT REQUEST!'
ptext=ptext||CENTER(ptext2,74)'\'
ulb=WORD(data.14,3)
IF ~DATATYPE(ulb,'W') | ulb=0 THEN ulb=1
dlb=WORD(data.15,3)
IF ~DATATYPE(dlb,'W') THEN dlb=0
dlup=TRUNC(dlb/ulb+.005,2)
line3='Level: 'level'   dl/ul:' dlup
IF upflag=0 THEN ptext=ptext||CENTER(line3,74)
IF upflag=1 THEN ptext=ptext||CENTER(line3'   Cmd:' opt arg,74)
IF upflag=2 THEN ptext=ptext||CENTER(line3'   MSG:' msg.msgdir,74)
IF upflag=3 THEN ptext=ptext||CENTER(line3'   Email',74)
IF upflag=4 THEN ptext=ptext||CENTER(line3'   ul:' arg 'in' plaindir,74)
IF upflag=5 THEN ptext=ptext||CENTER(line3'   dl:' arg 'in' plaindir,74)
IF upflag=6 THEN
  DO
    line3=line3'   Elapsed:'elapsed' '
    IF EXISTS(bbspath'Email/'sysop'/NEW_FILES') THEN line3=line3 'NEW_FILES'
    IF EXISTS(bbspath'Lists/NEW_USERS') THEN line3=line3 'NEW_USERS'
    ptext=ptext||CENTER(line3,74)
  END
IF GETCLIP('BBS_fkeyhelp')=1 THEN CALL PostMsg(3,11,ptext)
ELSE CALL PostMsg(lpost,rpost,ptext)
RETURN


whodat:
MSG RIGHT(' ',66-LENGTH(name)) '1B'x'M'||''||''||' 'name' level 'level' '||''
RETURN


showtime:
mins=TIME('E')%60
secs=TRUNC(TIME('E')//60)+1
IF secs>59 THEN secs=59
IF secs<10 THEN secs='0'secs
line=' Time:  Used' mins':'secs
mins=(maxtime-TIME('E'))%60
secs=TRUNC((maxtime-TIME('E'))//60)
IF secs<10 THEN secs='0'secs
line=line'   Remaining' mins':'secs
SAY line||CR

checktime:
IF TIME('E')>maxtime THEN
  DO
    SAY 'Sorry,' name 'your time has expired.'CR
    CALL send2log('*** Time Expired ***')
    SIGNAL LOGOUT2
  END
IF TIME('E')>(maxtime-120) THEN SAY '*** Less than 2 minutes left! ***'CR
CALL whodat()
CALL checkdcd()
RETURN


setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
Data directory
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN


config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'CR
    SIGNAL DONE2
  END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop=WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
  DO
    SAY msgpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
CALL SETCLIP('BBS_msgpath',msgpath)
msgpath=msgpath'MSG'
libpath=WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
  DO
    SAY libpath 'does not exist!'CR
    SIGNAL DONE2
  END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
CALL SETCLIP('BBS_libpath',libpath)
extdevs=''
DO i=1 TO WORDS(lynes.10)
  test=WORD(lynes.10,i)
  IF POS(':',test)=0 THEN ITERATE i
  IF LEFT(test,2)='/*' THEN LEAVE i
  extdevs=STRIP(extdevs test)
END
SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
maxidle=WORD(lynes.13,1)
maxtime=WORD(lynes.14,1)
maxbps=WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
CALL SETCLIP('BBS_baud',maxbps)
DO i=16 TO 31
  j=i-15
  bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  DO
    SAY spellpath 'does not exist!'CR
    bbsprefs.5=0
  END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
  DO
    extension='.lzh'
    arccom='lharc -m m'
  END
lpost=WORD(lynes.34,1)
IF ~DATATYPE(lpost,'W') THEN lpost=3
rpost=WORD(lynes.35,1)
IF ~DATATYPE(rpost,'W') THEN rpost=14
RETURN


readlogs:
IF arg='' THEN
  arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
IF arg='' THEN arg=DATE('S')
arg=bbspath'Logs/log.'arg
CALL readlines(arg 1)
CALL seelines(0)
nonstop=0
CALL waiting()
RETURN


loadcourtesy:
IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF readopen(bbspath'Lists/Courtesy') THEN
      DO
        SAY 'Checking Courtesy List...'CR
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          line=cleanstring(1':'line)
          courtesy=courtesy line
        END
        CALL CLOSE(f)
        MSG ''
        MSG pen3'Courtesy List:'def
        MSG courtesy
      END
  END
RETURN


fileheader:
SAY 'Filename          Bytes File# Library         KeyWords'CR
SAY pen3||LEFT('=',77,'=')||def||CR
RETURN


showalpha:
IF DATATYPE(arg,'W') THEN
  DO
    dirnum=arg
    arg=''
    IF chdir2()>0 THEN RETURN
    test='Y'
  END
ELSE
  DO
    test=getinput(1 1 'Show one library only? (Ny) > ')
    IF test='Y' THEN
      IF chdir()>0 THEN RETURN
  END

showalpha2:
IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
ELSE filecount=files.0
SAY '  'filecount 'files.'CR
CALL fileheader()
count=0
DO shi=1 TO alpha.0
  IF test='Y' THEN
    DO
      IF count>=filecount THEN LEAVE shi
      IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.shi,5),12)) THEN
        ITERATE shi
    END
  jj=WORD(alpha.shi,4)
  IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
    ITERATE shi
  SAY alpha.shi||CR
  count=count+1
  IF (count+2)//linesperpage=0 THEN
    IF waiting2() THEN LEAVE shi
END
nonstop=0
IF waitchar~='Q' THEN CALL waiting()
RETURN


profiles:
prodir=bbspath'Profiles'
CALL MAKEDIR(prodir)
pros=SHOWDIR(prodir)
protxt=bbspath'BBS_TEXT/PROFILES'
IF EXISTS(protxt) THEN CALL showtext(protxt)
DO lupe=1
  SAY CR
  SAY '       1. Edit 'name'''s user Profile'CR
  SAY '       2. View a User Profile'CR
  SAY '       3. Search User Profiles'CR
  SAY '       4. Browse User Profiles'CR
  SAY CR
  temp=getinput(1 1 'Enter Selection Number > ')
  IF temp=1 THEN
    DO
      lynes.=''
      IF EXISTS(prodir'/'name) THEN
        DO
          IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe
          CALL DELETE(prodir'/'name)
        END
      ELSE lynes.0=3
      lynes.1=name
      lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C')
      lynes.3=LEFT('=',74,'=')
      IF savelines(prodir'/'name)~=0 THEN
        DO
          line='Profile for' name 'failed to save!'
          SAY line||CR
          CALL send2log(line)
          ITERATE lupe
        END
      edtype=''
      CALL bbsEd(4 prodir'/'name)
      IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name)
      IF lynes.0<4 THEN CALL DELETE(prodir'/'name)
      pros=SHOWDIR(prodir)
    END
  ELSE IF temp=2 THEN
    DO pf=1
      totpros=WORDS(pros)
      DO pfl=1 TO totpros BY 3
        pfl2=pfl+1
        pfl3=pfl+2
        pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21)
        IF pfl2<=totpros THEN
          pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21)
        IF pfl3<=totpros THEN
          pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21)
        SAY pfline||CR
        IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN
          IF waiting(2) THEN LEAVE pfl1
      END
      emnum=getinput(1 0 pen3'Select User Profile Number > 'def)
      IF DATATYPE(emnum,'W') & emnum>0 & emnum<=totpros THEN
        DO
          tmp=WORD(pros,emnum)
          IF level>sysoplevel THEN
            DO
              CALL bbsEd(1 prodir'/'tmp)
              IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp)
              IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp)
              pros=SHOWDIR(prodir)
            END
          ELSE CALL showtext(prodir'/'tmp)
        END
      ELSE LEAVE pf
    END
  ELSE IF temp=3 | temp=4 THEN
    DO
      searcharg=''
      nonstop=0
      IF temp=3 THEN
        DO
          searcharg=STRIP(getinput(0 0 'Enter Search Phrase > '))
          IF searcharg='' THEN ITERATE lupe
        END
      DO ui=1 TO WORDS(pros)
        pro=prodir'/'WORD(pros,ui)
        IF temp=3 THEN
          IF textsearch(pro searcharg)=0 THEN ITERATE ui
        SAY CR
        CALL readlines(pro 1)
        IF nonstop=1 THEN rnonstop=1
        ELSE rnonstop=0
        CALL seelines(2)
        IF rnonstop THEN nonstop=1
        ELSE IF waiting2()=1 THEN LEAVE ui
        SAY CR
        SAY CR
      END
    END
  ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe
END
DROP pros
RETURN


otheruser:
line=''
IF level>sysoplevel THEN line='['pen3'R'def']eport or'
line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?'
IF level>sysoplevel THEN line=line '(Dnr) > '
ELSE line=line '(Dn) > '
temp=getinput(1 1 line)
IF temp='N' THEN
  DO
    CALL showuserlist()
    RETURN
  END
ELSE IF level>sysoplevel & temp='R' THEN
  DO
    SAY CR
    line=''
    IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
      DO
        CALL cleanline(0)
        SAY 'INACTIVE_USERS report will be in your email.'CR
        line='USERS '
      END
    IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
      DO
        CALL cleanline(0)
        line=line'FILES'
        line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > '))
        SAY 'FILELISTS_REPORT will be in your email.'CR
      END
    SAY CR
    ADDRESS AREXX bbsREPORT.rexx name line
    RETURN
  END
SAY CR
SAY 'To allow (or not) other users to see your street address and/or phone number,'CR
SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'CR
SAY CR
SAY 'User specification may include ? wildcard for single characters.'CR
SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'CR
IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
IF arg='' THEN RETURN
arg=TRANSLATE(STRIP(arg),'_',' ')
CALL FileList(bbspath'Users/*'arg'*',wildlist)
line='Found' wildlist.0 'match'
IF wildlist.0~=1 THEN line=line'es'
SAY line'.'CR
IF wildlist.0<1 THEN RETURN
totlines=0
nextpagebreak=linesperpage-3
extrainfo=0
IF level>sysoplevel THEN
  DO
    IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
      extrainfo=1
  END
DO i=1 TO wildlist.0
  CALL readlines(wildlist.i 1)
  SAY CR
  totlines=totlines+6
  SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def||CR
  SAY lynes.1||CR
  IF FIND(UPPER(lynes.8),'STREET')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.2||CR
    END
  SAY lynes.3||CR
  IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.4||CR
    END
  SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)||CR
  SAY pen3'Interests:'def lynes.10||CR
  IF extrainfo THEN
    DO
      SAY pen3'   up:'def lynes.14||CR
      SAY pen3' down:'def lynes.15||CR
      temptot=0
      DO j=1 TO WORDS(lynes.23)
        IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
      END
      SAY pen3' writ:'def temptot 'public messages.'CR
      SAY pen3'level:'def lynes.20||CR
      totlines=totlines+4
      IF lynes.21~='' THEN
        DO
          totlines=totlines+1
          SAY pen3'excluded dirs:'def lynes.21||CR
        END
    END
  IF nonstop~=1 & totlines>=nextpagebreak THEN
    DO
      IF waiting2() THEN LEAVE i
      nextpagebreak=totlines+linesperpage-5
    END
END
nonstop=0
DROP wildlist.
IF waitchar~='Q' THEN CALL waiting()
RETURN


changename:
ARG cname
IF level<=sysoplevel THEN RETURN
IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
IF WORD(lynes,20)>=level THEN RETURN
CALL SETCLIP('BBS_oldname',cname)
CALL ChangeUserName.rexx()
IF GETCLIP('BBS_oldname')='' THEN CALL send2log('Name Change:' cname)
cname=GETCLIP('BBS_newname')
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
CALL SETCLIP('BBS_oldname')
CALL SETCLIP('BBS_newname')
RETURN cname


levelreport:
minlev=0
maxlev=99
templist=''
uname=''
newufile=bbspath'Lists/NEW_USERS'
IF EXISTS(newufile) THEN
  DO
    IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN
      DO
        IF readlines(newufile 1)=0 THEN
          DO i=2 TO lynes.0
            templist=STRIP(templist WORD(lynes.i,5))
          END
      END
    ELSE newufile=''
  END
ELSE newufile=''
IF newufile='' THEN
  DO
    minlev=getinput(1 0 'Minimum level? (0) > ')
    maxlev=getinput(1 0 'Maximum level? (99) > ')
    IF ~DATATYPE(minlev,'W') THEN minlev=0
    IF ~DATATYPE(maxlev,'W') THEN maxlev=99
    IF minlev<0 | minlev>99 THEN minlev=0
    IF maxlev<0 | maxlev>99 THEN maxlev=99
    templist=userlist
  END
DO levi=1 TO WORDS(templist)
  arg=bbspath'Users/'WORD(templist,levi)
  CALL readlines(arg 1)
  IF lynes.20<minlev | lynes.20>maxlev THEN ITERATE levi
  line=lynes.20 WORD(templist,levi)
  SAY line||CR
  IF newufile~='' | WORD(lynes.20,1)<10 | ~DATATYPE(WORD(lynes.20,1),'W') THEN
    DO
      SAY CR||LF||line||CR
      DO levj=1 TO 12
        SAY pen3'  'lynes.levj||def||CR
      END
      SAY pen3'  'lynes.19||def||CR
    END
  IF ~DATATYPE(WORD(lynes.20,1),'W') | WORD(lynes.20,1)<10 THEN
    DO
      lcom=getinput(1 1 '['pen3'A'def']dd or ['pen3'K'def']ill or ['pen3'R'def']ename or ['pen3'S'def']kip this user? (Akrs) > ')
      CALL cleanline(0)
      IF lcom='K' THEN
        DO
          arg=WORD(templist,levi)
          CALL killuser()
        END
      ELSE IF lcom='R' THEN
        DO
          newname=changename(WORD(templist,levi))
          IF newname~='' & newname~=WORD(templist,levi) THEN
            DO
              temp=WORDINDEX(templist,levi+1)
              rtemp=''
              IF temp>0 THEN rtemp=SUBSTR(templist,temp)
              temp=WORDINDEX(templist,levi)
              templist=''
              IF temp>1 THEN templist=STRIP(LEFT(templist,temp-1))
              templist=STRIP(templist newname rtemp)
              userlist=userlist newname
            END
          levi=levi-1
          CALL SETCLIP('BBS_newname')
        END
      ELSE IF lcom~='S' THEN
        DO
          IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
            DO
              DO lvi=1 TO 21
                line=READLN(f)
                IF lvi=11 THEN lynes.11=line
                IF lvi=20 THEN lynes.20=line
              END
              lynes.21=line
              CALL CLOSE(f)
              edtype=''
              CALL savelines(arg)
              SAY lynes.20 WORD(templist,levi) 'has been made a member.'CR
            END
          ELSE SAY 'You need a default member file in BBS_TEXT!  ( BBS_TEXT/DEF.MEMBER )'CR
        END
      IF lcom~='K' & lcom~='R' THEN CALL writenew()
    END
  ELSE IF newufile~='' THEN CALL writenew()
END
IF newufile~='' THEN CALL DELETE(newufile)
DROP templist
RETURN


writenew:
arg=WORD(templist,levi)
IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
      IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN replysubj='|@NEW@|'
    CALL editor('MAIL' arg)
  END
RETURN


filereport:
SAY 'Searching for mismatches between files and filenotes...'CR
DO i=1 TO sysoplevel+1
  IF dirs.i='' THEN ITERATE
  SAY dirs.i'                               'lineup||CR
  rfiles=SHOWDIR(libpath||dirs.i)
  rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  IF WORDS(rfiles)~=WORDS(rnotes) THEN
    DO
      line='Compare files & filenotes in'pen3 dirs.i||def'. '
      DO j=1 TO WORDS(rfiles)
        IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
          line=line WORD(rfiles,j)
      END
      SAY line||CR
    END
END
Send '^G'
CALL waiting()
RETURN


mailreport:
SAY 'Checking ALL pending Email...'CR
SAY pen3' - Use CTRL-E to Exit -'def||CR
SAY CR
mailrep=SHOWDIR(bbspath'Email','D')
mailfil=SHOWDIR(bbspath'EmailFiles','D')
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'W') THEN lastemail=0
IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN
  DO
    DROP mailrep. mailfil.
    RETURN
  END
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
  muser=WORD(mailrep,mi)
  IF muser=sysop | muser=name THEN ITERATE mi
  mlist=SHOWDIR(bbspath'Email/'muser)
  IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)||CR
  DO mj=1 TO WORDS(mlist)
    fuser=WORD(mlist,mj)
    IF POS(sysop,fuser)>0 THEN ITERATE mj
    IF logonflag=0 THEN
      DO
        mk=mk+1
        mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
      END
    IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
      DO
        testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
        IF testnum>emailnum THEN emailnum=testnum
        IF testnum>lastemail THEN
          DO
            CALL showtext(bbspath'Email/'muser'/'fuser)
            SAY CR
            SAY CR
            IF waitchar='Q' THEN LEAVE mi
          END
      END
  END
  IF logonflag=0 & FIND(mailfil,muser)>0 THEN
    DO
      efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
      IF WORDS(efilelist)>0 THEN
        DO
          mk=mk+1
          mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
        END
    END
END
data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0)
IF mk>0 THEN
  DO
    lynes.0=mk
    DO mi=1 TO mk
      lynes.mi=mailynes.mi
    END
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
ELSE SAY 'No unseen Email pending.'CR
DROP mailrep. mailfil. mailynes. mlist
RETURN


jump2rexx:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  DO
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    SAY 'Sorting..'lineup||CR
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      jdoors.i=LEFT(RIGHT(i,3)'.' LEFT(doors.i,LENGTH(doors.i)-5),24)
      DO j=1 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
      END
    END
  END
DO doorloop=1
  SAY pen3||LEFT('-',75,'-')||def||CR
  DO jd=1 TO jdoors.0
    SAY jdoors.jd||CR
    IF jd//linesperpage=0 THEN CALL waiting()
    IF waitchar='Q' THEN RETURN
  END
  temp=getinput(1 0 pen3'Select Application Number > 'def)
  IF ~DATATYPE(temp,'W') | temp<1 | temp>doors.0 THEN RETURN
  arg=doors.temp
  CALL postuser(1)
  curdir=PRAGMA('D')
  CALL setdir(bbspath'rexxDoors')
  CALL send2log('Door: 'doors.temp 'at' TIME('C'))
  CALL SETCLIP('BBS_winnings')
  savewinnings=0
  timeleft=TRUNC(maxtime-TIME('E'))
  IF UPPER(doors.temp)='ONE_ARMED_BANDIT.REXX' THEN
    IF getinput(1 1 'Play for this sessions time in seconds? (Ny) > ')='Y' THEN
      DO
        savewinnings=winnings
        IF savewinnings=0 THEN savewinnings=1
        winnings=timeleft
        SAY 'Playing for REAL seconds, not wimpy play-dollars!'CR
      END
  CALL SETCLIP('BBS_door_demon',timeleft)
  ADDRESS AREXX doorDemon.baud
  comm='SIGNAL OFF ERROR;SIGNAL OFF SYNTAX;'
  comm=comm'SIGNAL OFF FAILURE;SIGNAL OFF BREAK_C;SIGNAL OFF BREAK_E;'
  comm=comm'CALL' doors.temp'('name winnings savewinnings colorflag')'
  INTERPRET comm
  SIGNAL ON SYNTAX
  SIGNAL ON FAILURE
  SIGNAL ON BREAK_C
  testwin=GETCLIP('BBS_winnings')
  IF DATATYPE(testwin,'N') THEN
    DO
      IF savewinnings>0 THEN
        DO
          IF testwin>7200 THEN
            DO
              SAY 'Although you won' TRUNC(testwin/60) 'minutes, the maximum session time is 120 minutes.'CR
              testwin=7200
            END
          maxtime=TRUNC(testwin+TIME('E'))
          winnings=savewinnings
        END
      ELSE winnings=testwin
    END
  CALL setdir(curdir)
  CALL SETCLIP('BBS_winnings')
  IF SHOW('P','BBS_DOOR_DEMON') THEN CALL SETCLIP('BBS_door_demon','QUIT')
  SAY CR
  CALL showtime()
END
RETURN


sortlibraries:
SAY 'Sorting Libraries...'CR
count=0
sdirs.=''
DO i=1 TO level
  IF dirs.i='' THEN ITERATE i
  count=count+1
  sdirs.count=dirs.i i
END
sdirs.0=count
CALL QSort(1,count,sdirs)
count=0
libs.=''
DO i=1 TO sdirs.0
  tempnum=WORD(sdirs.i,2)
  tempdir=WORD(sdirs.i,1)
  IF FIND(data.21,UPPER(tempdir))=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'. 'LEFT(tempdir,14)
      count=count+1
      libs.count=string
    END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
  DO j=1 TO 3
    k=i+j*libs.0
    IF k<=count THEN libs.i=libs.i||libs.k
  END
END
DROP sdirs.
CALL sortconferences()
RETURN


sortconferences:
SAY 'Sorting Conferences...'CR
count=0
smsg.=''
DO i=1 TO level
  IF msg.i='' THEN ITERATE i
  count=count+1
  smsg.count=msg.i i
END
smsg.0=count
CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
  tempnum=WORD(smsg.i,2)
  tempdir=WORD(smsg.i,1)
  IF FIND(data.21,tempnum)=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'.'
      IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
        string=string LEFT(tempdir,20)
      ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
      count=count+1
      msgs.count=string
    END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
  DO j=1 TO 2
    k=i+j*msgs.0
    IF k<=count THEN msgs.i=msgs.i msgs.k
  END
END
DROP smsg.
RETURN


readmessages:
searcharg=''
DO FOREVER
  SAY CR
  PARSE VAR arg temp' 'arg .
  IF DATATYPE(temp,'W') THEN msgdir=temp
  ELSE IF LEFT(UPPER(temp),1)='A' THEN
    DO
      CALL newmsgs()
      arg=''
      RETURN
    END
  ELSE IF LEFT(UPPER(temp),1)='M' THEN
    DO
      CALL readmarked()
      arg=''
      RETURN
    END
  ELSE
    DO
      SAY 'Select Message Conference By Number, ['pen3'M'def']arked only or ['pen3'A'def']ll Active'CR
      IF areaselect() THEN
        DO
          IF LEFT(temp,1)='A' THEN CALL newmsgs()
          IF LEFT(temp,1)='M' THEN CALL readmarked()
          RETURN
        END
    END
  pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF'
  pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > '
  IF arg~='' THEN junk=UPPER(LEFT(arg,1))
  ELSE junk=getinput(1 1 pline)
  IF junk='Q' THEN RETURN
  IF junk='A' THEN
    DO
      SAY CR
      CALL msgcount(msgdir)
      junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ')
      IF junk='Q' THEN RETURN
      IF DATATYPE(junk,'W') THEN
        DO
          IF junk>lastmess | junk<1 THEN junk=1
          lastread.msgdir=junk-1
          CALL savedata(1)
        END
      CALL SETCLIP('BBS_MSGS','ON')
      SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'CR
      lastread.msgdir=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
      CALL send2log('Arc: ArcMsgs.rexx' msg.msgdir)
      ADDRESS AREXX ArcMsgs.rexx name msgdir
      IF emailonline>=0 THEN emailonline=emailonline+1
      DO WHILE GETCLIP('BBS_MSGS')~=''
        CALL DELAY(14)
      END
      SAY 'When completed, the archive will be attached to email addressed to you.'CR
      CALL savedata(1)
      SAY CR
      RETURN
    END
  IF junk='S' THEN
    DO
      searcharg=''
      searcharg=getinput(0 0 pen3'Search Phrase: 'def)
      IF LENGTH(STRIP(searcharg))=0 THEN RETURN
      searcharg=COMPRESS(searcharg,'*')
      CALL searchmsgdir()
      searcharg=''
      RETURN
    END
  IF junk='T' THEN
    DO
      line='Turning the' msg.msgdir 'conference'
      IF WORD(data.22,msgdir)<0 THEN
        DO
          line=line pen3'ON'def'.'
          newdata='0'
        END
      ELSE
        DO
          line=line pen3'OFF'def'.'
          newdata='-1'
        END
      SAY line||CR
      dataloc=WORDINDEX(data.22,msgdir)-1
      data.22=DELWORD(data.22,msgdir,1)
      IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc)
      CALL sortconferences()
    END
  CALL readmsg(0)
  CALL saveData(1)
  nonstop=0
  arg=''
END
RETURN


newmsgs:
test=UPPER(LEFT(arg,1))
IF test='' THEN
  test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ')
IF test='A' THEN
  DO
    CALL SETCLIP('BBS_MSGS','ON')
    SAY CR
    SAY 'Archiving new conference messages...'CR
    CALL send2log('Arc: ArcMsgs.rexx')
    ADDRESS AREXX ArcMsgs.rexx name
    IF emailonline>=0 THEN emailonline=emailonline+1
    clear_marked=1
    DO i=1 TO level
      IF WORD(data.22,i)~=-1 THEN
        lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
    END
    DO WHILE GETCLIP('BBS_MSGS')~=''
      CALL DELAY(14)
    END
    SAY 'When completed, the archive will be attached to email addressed to you.'CR
    CALL savedata(1)
    SAY CR
    RETURN
  END
curmsgdir=msgdir
SAY 'Scanning all Conferences for new messages..'CR
DO newi=1 TO level
  IF msg.newi='' THEN ITERATE newi
  msgdir=newi
  CALL readmsg(1)
  IF msgcom='Q' THEN LEAVE newi
END
CALL saveData(1)
msgdir=curmsgdir
nonstop=0
RETURN


readmsg:
ARG quietflag marknum .
msgcom=''
IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
IF WORD(data.22,msgdir)=-1 THEN RETURN;                /* user  excluded */
entering='Entering'pen3 msg.msgdir def'Message Conference..'
IF quietflag=0 & marknum='' THEN SAY entering||CR
CALL postuser(2)
IF DATATYPE(WORD(data.22,msgdir),'W') THEN
  lastread.msgdir=WORD(data.22,msgdir)
ELSE lastread.msgdir=0
lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
temp=''
IF marknum='' THEN
  DO
    IF lastread.msgdir>=lstwrt | lastread.msgdir<frstwrt THEN
      DO
        lastread.msgdir=lstwrt
        CALL msgcount(msgdir)
        IF quietflag=1 & lastread.msgdir=lstwrt THEN RETURN
        IF nonstop=1 THEN temp=''
        ELSE temp=getinput(1 0 pen3'Enter starting message number > 'def)
        IF temp='' THEN temp=lastread.msgdir
        IF ~DATATYPE(temp,'W') THEN RETURN
        IF temp<frstwrt THEN temp=frstwrt
        IF temp>lstwrt THEN temp=lstwrt
        IF temp<1 THEN temp=1
        lastread.msgdir=temp-1
      END
  END
ELSE lastread.msgdir=marknum-1
IF quietflag=1 THEN SAY entering||CR
dirname=msgpath||msgdir
msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
firstmess=999999
testlist=SHOWDIR(dirname)
DO i=1 TO WORDS(testlist)
  test=WORD(testlist,i)
  IF test>lastread.msgdir THEN msglist.test=1
  IF test<firstmess THEN firstmess=test
END
IF firstmess=999999 THEN firstmess=0
CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
msgstatus=1
IF temp='' & marknum='' THEN CALL msgcount(msgdir)
skipsubj.=''
skipsubj.0=0
DO msgloop=1
  lastreadnum=lastread.msgdir
  DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
    lastreadnum=lastreadnum+1
  END
  lastread.msgdir=lastreadnum
  IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN LEAVE msgloop
  DO mess=lastread.msgdir TO lstwrt+1
    IF marknum~='' THEN
      DO
        IF mess>marknum THEN LEAVE msgloop
        mess=marknum
      END
    IF msglist.mess~=msgstatus THEN ITERATE mess
    IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'CR
    msglist.mess=0
    arg=dirname'/'mess
    IF ~EXISTS(arg) THEN
      DO
        SAY 'Message number' mess 'is missing.'CR
        ITERATE mess
      END
    IF ~readopen(arg) THEN ITERATE mess
    firstline=READLN(f)
    secondline=READLN(f)
    thirdline=READLN(f)
    forthline=READLN(f)
    CALL CLOSE(f)
    CALL killmark(msgdir mess)
    DO skp=1 TO skipsubj.0
      IF forthline=skipsubj.skp THEN ITERATE mess
    END
    IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
      DO
        thread=SUBSTR(firstline,WORDINDEX(firstline,4))
        DO tindx=1 TO WORDS(thread)
          test=WORD(thread,tindx)
          IF msglist.test~=0 THEN msglist.test=msgstatus+1
        END
      END
    savearg=arg
    msgcom='A'
    DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
      CALL readlines(arg 1)
      IF nonstop=1 THEN rnonstop=1
      ELSE rnonstop=0
      CALL seelines(2)
      msgcom=''
      IF rnonstop THEN
        DO
          SAY CR
          nonstop=1
          msgcom=''
        END
      ELSE
        DO
          pline=''
          IF level<=sysoplevel | WORDS(lynes.3)<3 THEN pline='['pen3'A'def']gain'
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
          IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove'
          IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
          pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
          IF level=99 THEN pline=pline '['pen3'!'def']'
          pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']'
          msgcom=getinput(1 0 STRIP(pline)' > ')
          CALL cleanline(0)
        END
      CALL checktime()
      IF DATATYPE(msgcom,'W') & EXISTS(dirname'/'msgcom) THEN
        DO
          arg=dirname'/'msgcom
          IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom
          msgcom='A'
          ITERATE msgloop2
        END
      ELSE msgcom=LEFT(msgcom,1)
      IF msgcom='Q' THEN LEAVE msgloop
      ELSE IF msgcom='!' & level>sysoplevel THEN
        DO
          CALL DELETE(arg)
          newchar=LEFT(lynes.1,1)
          IF newchar~='!' THEN newchar='!!'
          ELSE newchar='  '
          lynes.1=OVERLAY(newchar,lynes.1,1,2)
          CALL savelines(arg)
          ITERATE msgloop2
        END
      ELSE IF msgcom='A' THEN ITERATE msgloop2
      ELSE IF msgcom='M' & level>sysoplevel THEN
        DO
          prevmsgdir=msgdir
          If areaselect()=0 THEN
            DO
              himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1
              lynes.1='  Msg:' himsg
              lynes.3='   To:' WORD(lynes.3,2)
              lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir
              nlyn=lynes.0+1
              lynes.0=nlyn
              lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***'
              CALL savelines(msgpath||msgdir'/'himsg)
              CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg)
              CALL msgmark(WORD(lynes.3,2) msgdir himsg)
              CALL readlines(arg 1)
              CALL DELETE(arg)
              CALL DELAY(28)
              lynes.0=7
              lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***'
              CALL savelines(arg)
            END
          msgdir=prevmsgdir
          msgcom='A'
        END
      ELSE IF msgcom='N' THEN
        DO
          nonstop=1
          msgcom=''
        END
      ELSE IF msgcom='H' | msgcom='?' THEN
        DO
          SAY pen3' - HELP with the Read Messages commands -'def||CR
          SAY ' RETURN reads the next message in line.'CR
          SAY ' 34 will read message number 34, if it exists in this conference.'CR
          SAY ' A  reads this message Again (in case it scrolled off screen).'CR
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
          SAY ' E  puts this message into the online Editor.'CR
          SAY ' K  deletes a message you wrote. you cannot Kill others!'CR
            END
          IF level>sysoplevel THEN
          SAY ' M  move this message to a new conference.'CR
          SAY ' N  displays all new messages without pausing. CTRL-E to Exit!'CR
          SAY ' O  if this message is a reply, will read the Original message.'CR
          SAY ' R  enters the message editor to Reply to this message.'CR
          SAY ' S  allows you to Skip threads or conferences.'CR
        IF level=99 THEN
          SAY ' !  toggles the do-not-purge! flag for this message.'CR
          SAY ' Q  returns to the message menu. (Quit)'CR
          SAY CR
          CALL waiting()
          msgcom='A'
          IF waitchar='Q' THEN LEAVE msgloop
        END
      ELSE IF msgcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              sline=7
              IF level>sysoplevel THEN sline=1
              CALL bbsED(sline arg)
              msgcom='A'
            END
        END
      ELSE IF msgcom='S' & mess<lstwrt THEN
        DO
          stemp=''
          DO WHILE stemp~='T' & stemp~='C'
            stemp=getinput(1 1 'Skip this ['pen3'T'def']hread or the entire ['pen3'C'def']onference (ct) > ')
          END
          IF stemp='T' THEN
            DO
              SAY CR
              SAY pen3 forthline||def||CR
              SAY 'Skipping messages with this subject heading...'CR
              SAY CR
              DO i=lastread.msgdir TO lstwrt
                IF msglist.i>1 THEN msglist.i=0
              END
              skipsubj.0=skipsubj.0+1
              sksb=skipsubj.0
              skipsubj.sksb=forthline
            END
          ELSE
            DO
              SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def||CR
              lastread.msgdir=lstwrt-1
              lw=lstwrt-1
              msglist.lw=0
              msglist.lstwrt=1
              LEAVE mess
            END
        END
      ELSE IF msgcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN
                DO
                  IF DELETE(arg)=1 THEN
                    SAY pen3||arg||def' has been deleted.'CR
                  grand=grand-1
                  msg.msgdir.0=msg.msgdir.0-1
                END
            END
        END
      ELSE IF msgcom='O' THEN   /* go back and read original */
        DO
          IF WORDS(lynes.3)>3 THEN
            DO
              temp=WORD(lynes.3,4)
              arg=dirname'/'temp
            END
          ELSE SAY 'This is the original message.'CR
        END
      ELSE IF msgcom='R' THEN        /*  toname     msgnum  */
        DO
          msgnum=WORD(lynes.1,2)
          forthline=lynes.4
          IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
            DO
              savearg2=arg
              arg=dirname'/'WORD(lynes.3,4)
              IF EXISTS(arg) THEN
                DO
                  IF readlines(arg 1) THEN BREAK
                  xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess)
                  IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
                  ELSE lynes.1=lynes.1'   Reply' xmsg
                  CALL DELAY(28)    /* allow 1/2 sec for read to close */
                  CALL savelines(arg)
                END
              arg=savearg2
            END
        END
      ELSE IF arg~=savearg THEN    /* Continue */
        DO
          msgcom='A'
          arg=savearg
        END
    END
    IF thread~='' THEN
      DO
        thread=''
        msgstatus=msgstatus+1
      END
  END
  IF msgstatus>1 THEN msgstatus=msgstatus-1
END
DROP msglist. skipsubj.
IF quietflag~=1 THEN nonstop=0
RETURN


showmarked:
IF WORDS(data.24)<1 THEN RETURN
SAY CR
SAY pen6'These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'def||CR
tempkk=data.24
DO i=1 TO WORDS(tempkk)
  tempk=WORD(tempkk,i)
  PARSE VAR tempk kdir'/'kmsg
  IF EXISTS(msgpath||kdir'/'kmsg) THEN
    SAY RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference.'CR
  ELSE data.24=DELWORD(data24,FIND(data.24,tempk))
END
CALL waiting()
SAY CR
RETURN


killmark:
PARSE ARG kdir kmsg .
IF data.24='' THEN RETURN
markword=FIND(data.24,kdir'/'kmsg)
IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
RETURN


readmarked:
mrknum=WORDS(data.24)
IF mrknum=0 THEN RETURN
SAY 'Reading only messages addressed to you...'CR
mrklist=data.24
msgcom=''
DO rmki=1 TO mrknum WHILE msgcom~='Q'
  tempk=WORD(mrklist,rmki)
  PARSE VAR tempk mkdir'/'mkmsg .
  IF ~EXISTS(msgpath||tempk) THEN
    DO
      CALL killmark(mkdir mkmsg)
      SAY CR
      SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'CR
      SAY CR
      ITERATE rmki
    END
  msgdir=mkdir
  savelast=lastread.msgdir
  CALL readmsg(1 mkmsg)
  IF mkmsg>savelast THEN lastread.msgdir=mkmsg
  ELSE lastread.msgdir=savelast
END
CALL saveData(1)
RETURN


sortnumbers:
PARSE ARG slist
IF STRIP(slist)='' THEN RETURN ''
sorted.=''
oldest=999999
newest=0
newlist=''
DO si=1 TO WORDS(slist)
  testword=WORD(slist,si)
  IF ~DATATYPE(testword,'W') THEN
    DO
      testpos=LASTPOS('.',testword)
      IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
      ELSE
        DO
          newlist=testword newlist
          ITERATE si
        END
    END
  ELSE tempnum=testword/1
  IF sorted.tempnum='' THEN
    DO
      sorted.tempnum=testword
      sorted.tempnum.0=1
      IF DATATYPE(tempnum,'W') THEN
        DO
          IF tempnum>newest THEN newest=tempnum
          IF tempnum<oldest THEN oldest=tempnum
        END
    END
  ELSE newlist=newlist testword
END
IF oldest~=999999 & newest~=0 THEN
  DO si=oldest TO newest
    IF sorted.si.0=1 THEN newlist=newlist sorted.si
  END
DROP sorted. oldest newest
RETURN STRIP(newlist)


readmail:
ARG fromenu .
CALL postuser(3)
replysubj=''
IF fromenu THEN
  DO
    temp=UPPER(arg)
    arg=''
    IF temp~='F' & temp~='T' & temp~='W' THEN
      DO
        line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email (ftw) > 'def
        temp=getinput(1 1 line)
        CALL cleanline(0)
      END
    IF temp='W' THEN
      DO
        CALL editor('MAIL')
        RETURN
      END
    ELSE IF temp='F' THEN
      DO
        firsteditline=0
        picklist.=''
        picklist.0=0
        IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN
          DO
            picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ')
            picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_')
            picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ')
            IF picklist.1='' THEN RETURN
            IF FIND(userlist,picklist.1)=0 THEN
              DO
                SAY '***'pen3 picklist.1 def'does not exist!'||CR
                picklist.0=0
                RETURN
              END
            fmaillist=SHOWDIR(bbspath'EMail/'picklist.1)
            DO ej=1 TO WORDS(fmaillist)
              ejname=WORD(fmaillist,ej)
              uname=ejname
              caret=LASTPOS('.',uname)
              IF caret>2 THEN uname=LEFT(uname,caret-1)
              IF uname=name THEN
                DO
                  arg=bbspath'EMail/'picklist.1'/'ejname
                  IF EXISTS(arg) THEN
                    DO
                      pklst=picklist.0+1
                      picklist.pklst=picklist.1
                      picklist.pklst.0=ejname
                      picklist.0=pklst
                    END
                END
            END
            IF picklist.0=0 THEN SAY 'No Email FROM you was found.'||CR
            ELSE
              DO
                SAY pen3'You have the following Email pending:'def||CR
                pickcheck=1
                DO WHILE pickcheck~=0
                  pickcheck=pickfromlist()
                  IF pickcheck~=0 THEN
                    DO
                      firsteditline=5
                      IF level>sysoplevel THEN firsteditline=1
                      CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
                      IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
                        picklist.pickcheck='- KILLED -'
                    END
                END
              END
          END
        ELSE
          DO
            SAY pen3'Scanning'def WORDS(userlist) pen3'email directories...'def||CR
            DO ei=1 TO WORDS(userlist)
              fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,ei))
              DO ej=1 TO WORDS(fmaillist)
                ejname=WORD(fmaillist,ej)
                uname=ejname
                caret=LASTPOS('.',uname)
                IF caret>2 THEN uname=LEFT(uname,caret-1)
                IF uname=name THEN
                  DO
                    arg=bbspath'EMail/'WORD(userlist,ei)'/'ejname
                    IF EXISTS(arg) THEN
                      DO
                        pklst=picklist.0+1
                        picklist.pklst=WORD(userlist,ei)
                        picklist.pklst.0=ejname
                        picklist.0=pklst
                      END
                  END
              END
            END
            IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                  'CR
            ELSE
              DO
                SAY pen3'You have Email pending to the following users:'def||CR
                pickcheck=1
                DO WHILE pickcheck~=0
                  pickcheck=pickfromlist()
                  IF pickcheck~=0 THEN
                    DO
                      firsteditline=5
                      IF level>sysoplevel THEN firsteditline=1
                      CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
                      IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
                        picklist.pickcheck='- KILLED -'
                    END
                END
              END
          END
        DROP picklist.
        RETURN
      END
    ELSE IF temp='T' THEN BREAK
    ELSE RETURN
  END
SAY 'Checking your mailbox..'CR
nomail=1
CALL MAKEDIR(bbspath'EMail/'name)
mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
IF WORDS(mailist)=0 THEN RETURN
line=WORDS(mailist)
IF line>1 THEN line=line 'letters'
ELSE line=line 'letter'
line=line 'waiting.'
SAY line||CR
DO ii=1 TO WORDS(mailist)
  SAY 'Email:' pen3||WORD(mailist,ii)||def||CR
END
IF ~fromenu THEN
  IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
onename=''
IF WORDS(mailist)>3 THEN
  DO
    IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN
      DO
        onename=getinput(1 0 'Read ONLY private mail from? > ')
        onename=SPACE(STRIP(UPPER(onename)),1,'_')
        onename=COMPRESS(onename,'.,:/*#?^ ')
        IF onename='' THEN RETURN
        IF FIND(userlist,onename)=0 & picklist.1~='BBBBS' THEN
          DO
            SAY '***'pen3 onename def'does not exist!'||CR
            RETURN
          END
      END
  END
DO letter=1 TO WORDS(mailist)
  readname=WORD(mailist,letter)
  uname=readname
  caret=LASTPOS('.',uname)
  IF caret>2 THEN uname=LEFT(uname,caret-1)
  IF onename~='' & onename~=uname THEN ITERATE letter
  arg=bbspath'Email/'name'/'readname        /* user has mail! */
  CALL readlines(arg 1)
  CALL seelines(1)
  nomail=0
  nonstop=0
  mailfile=''
  IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
  ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4)
  IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
    DO
      IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN
        DO
          SAY CR
          SAY pen3'The attached file is unarchived and may be incomplete.'CR
          SAY 'If the archiver is still building this file, downloading will fail.'def||CR
          IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter
          SAY CR
        END
      curdir=PRAGMA('D')
      CALL setdir(bbspath'EmailFiles/'name)
      filesize=WORD(STATEF(mailfile),2)
      IF getinput(1 1 ' Attached file:' pen3||mailfile||def 'is' pen3||filesize||def 'bytes.  Download now? (nY) > ')~='N' THEN
        DO
          savearg=arg
          arg=mailfile
          DO WHILE dload()=1
          END
          arg=savearg
        END
      CALL setdir(curdir)
    END
  IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
    DO
      tempchar='A'
      DO WHILE tempchar='A'
        tempchar=getinput(1 1 '['pen3'A'def']gain  ['pen3'C'def']ontinue  ['pen3'R'def']eply (acR) > ')
        IF tempchar='' THEN tempchar='R'
        IF tempchar='A' THEN CALL seelines(1)
      END
      IF tempchar='R' THEN
        DO
          IF WORDS(lynes.4)<2 THEN replysubj='NONE'
          ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
          CALL editor('MAIL' uname)
          replysubj=''
        END
    END
  IF LEFT(readname,6)~='BBBBS.' THEN
    DO
      tempchar='A'
      DO WHILE tempchar='A'
        tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ')
        IF tempchar='A' THEN CALL seelines(1)
      END
      IF tempchar='Y' THEN
        DO
          IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN
            DO ei=1 TO thechosen.0 WHILE thechosen.ei~=''
              CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
              forwardarg=bbspath'Email/'thechosen.ei'/'readname
              ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
              CALL readlines(forwardarg 1)
              lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
              CALL DELETE(forwardarg)
              CALL savelines(forwardarg)
              IF WORDS(lynes.2)>3 THEN
                DO
                  forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
                  IF EXISTS(forname) THEN
                    DO
                      CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
                      ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei
                    END
                END
              line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
              IF emailonline>=0 THEN emailonline=emailonline+1
              CALL send2log(line)
              SAY line||CR
            END
        END
    END
  tempchar=getinput(1 1 'Delete the mail from'pen3 uname def'you just read? (nqY) > 'def)
  IF tempchar='Q' THEN
    DO
      IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
        DO
          readname=''
          uname=''
          RETURN
        END
    END
  ELSE IF tempchar~='N' THEN
    DO
      dirname=bbspath'Email/'name'/'
      nodelete=0
      IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
        nodelete=1
      IF nodelete THEN
        ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
      ELSE emailonline=emailonline-1
      CALL DELETE(dirname||readname)
      tempstr='Old email'
      IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
        DO
          IF nodelete THEN
            ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl')
          tempstr=tempstr 'and attached file'
        END
      tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
      SAY tempstr||CR
      IF tempchar='Q' THEN
        IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
          DO
            readname=''
            uname=''
            RETURN
          END
    END
  ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
    DO
      ii=LEFT(readname,POS('.',readname)-1)
      ii=SUBSTR(ii,4)%1
      IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN
        DO
          temp=TRANSLATE(readname,'/','.')
          temp=SUBSTR(temp,4)
          lynes.1='!!'STRIP(lynes.1)
          edtype=''
          CALL savelines(msgpath||temp)
          CALL DELETE(bbspath'Email/'name'/'readname)
        END
    END
  ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
    DO
      arg=bbspath'Email/'name'/'readname
      CALL readlines(arg 1)
      IF WORDS(lynes.5)<7 THEN
        DO
          lynes.5=lynes.5'  (Rcvd)' DATE('W') DATE() TIME('C')
          CALL DELETE(arg)
          CALL savelines(arg)
          SAY 'Email has been marked as received.'CR
        END
    END
  CALL checktime()
  readname=''
  uname=''
  arg=''
END
IF nomail THEN
  DO
    SAY 'No mail was found.'CR
    CALL waiting()
  END
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN


selectchosen:
PARSE ARG startat selectline
IF startat<2 THEN thechosen.=''
line='Enter list of comma separated user names'
IF level>sysoplevel THEN line=line 'or ALL'
SAY line||CR
thechosen.startat=getinput(1 0 selectline' ')
IF STRIP(thechosen.startat)='' THEN RETURN 1
thechosen.startat=SPACE(thechosen.startat,1,'_')
thechosen.0=startat
IF level>sysoplevel & thechosen.startat='ALL' THEN
  thechosen.startat=SHOWDIR(bbspath'Users','F',',')
IF POS(',',thechosen.startat)>0 THEN
  DO
    temp=TRANSLATE(thechosen.startat,' ',',')
    thechosen.0=thechosen.0+WORDS(temp)-1
    DO ei=1 TO WORDS(temp)
      eii=startat+ei-1
      thechosen.eii=STRIP(WORD(temp,ei))
    END
  END
DO ei=startat TO thechosen.0
  DO WHILE FIND(userlist,thechosen.ei)=0
    IF thechosen.ei~='' THEN
      DO
        IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
          DO
            thechosen.ei=sysop
            ITERATE ei
          END
        CALL loadcourtesy()
        IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
      END
    SAY thechosen.ei 'not found! Enter that name again or press RETURN.'CR
    thechosen.ei=getinput(1 0 pen3||selectline' 'def)
    IF thechosen.ei='' THEN
      DO
        IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
          CALL showuserlist()
        ITERATE ei
      END
    thechosen.ei=SPACE(thechosen.ei,1,'_')
  END
END
RETURN 0


countcheck:
PARSE ARG fname' 'cknum' '.
IF ~EXISTS(fname) THEN
  DO
    IF cknum=0 THEN RETURN 0
    IF ~writeopen(fname) THEN RETURN 0
    CALL WRITELN(f,cknum)
    CALL CLOSE(f)
    RETURN cknum
  END
IF ~readopen(fname) THEN RETURN cknum
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
  DO
    IF writeopen(fname) THEN
      DO
        CALL WRITELN(f,cknum)
        CALL CLOSE(f)
        RETURN cknum
      END
  END
RETURN retval


pickfromlist:
DO pfl=1 TO picklist.0 BY 3
  pfl2=pfl+1
  pfl3=pfl+2
  pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
  IF picklist.pfl2~='' THEN
    pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
  IF picklist.pfl3~='' THEN
    pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
  SAY pfline||CR
END
emnum=getinput(1 0 pen3'Select Email Number > 'def)
IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0
RETURN emnum


sysED:
IF level<99 THEN RETURN
arg=getinput(0 0 'Textfile To Edit: ')
IF arg='' THEN RETURN
CALL bbsED(1 arg)
RETURN


bbsED:
PARSE ARG firstedit editarg .
notchanged=1
IF readlines(editarg 1) THEN RETURN 1
finfo=STATEF(editarg)
IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
ELSE finfo=''
SAY CR
SAY '                   'pen3'Entering the EDITOR module..'def||CR
SAY CR
count=1
DO edloop=1
  IF edcom='S' & bbsprefs.5 THEN  /* spell check */
    DO
      SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def||CR
      CALL DELETE(scratch'/SpellFile')
      CALL savelines(scratch'/SpellFile')
      curdir=PRAGMA('D')
      CALL setdir(spellpath)
      CALL SpellChk.rexx(scratch'/SpellFile')
      CALL setdir(curdir)
    END
  ELSE
    DO
      IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
      IF edcom~='L' THEN count=count-linesperpage
      IF count>=lynes.0 | count<1 THEN count=1
      startcount=count
      DO i=startcount TO lynes.0+1
        IF ((i+1-startcount)//linesperpage)=0 THEN
          DO
            pline='                 ['pen3'E'def']dit'
            pline=pline '  ['pen3'RETURN'def']=Continue '
            edcom=getinput(1 1 pline)
            IF edcom~='' THEN LEAVE i
            CALL cleanline(1)
          END
        SAY pen3||RIGHT(i,3)||def lynes.i||CR
        count=count+1
      END
    END
  CALL checktime()
  SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'CR
  pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  pline=pline '['pen3'U'def']pload-Text > '
  edcom=getinput(1 0 pline)
  IF edcom='Q' | edcom='X' THEN edcom=''
  IF edcom='?' THEN
    DO
      SAY CR
      SAY '                   Editor Help'CR
      SAY '-------------------------------------------------------'CR
      SAY ' 7  edits line number 7, if it exists.'CR
      SAY ' a  Append text to this file.'CR
      SAY ' c  Cut selected line(s) of text to buffer.'CR
      SAY ' i  Insert blank line.'CR
      SAY ' k  Kill (delete) this file.'CR
      SAY ' l  List this file from selected line.'CR
      SAY ' p  Paste buffer contents to selected line number.'CR
      SAY ' r  Replace a phrase or line of text.'CR
      SAY ' s  Spellcheck this file.'CR
      SAY ' u  Upload a textfile to append to this file.'CR
      SAY '    An empty RETURN indicates you are finished editing.'CR
      SAY '-------------------------------------------------------'CR
      SAY CR
      OPTIONS PROMPT ''
      PULL
    END
  IF edcom='K' THEN
    DO
      junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
      IF junk='Y' THEN
        DO
          IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'CR
          IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
            DO
              IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
                SAY WORD(lynes.2,4) 'DELETED.'CR
            END
          RETURN 2
        END
    END
  IF edcom='' THEN
    DO
      SAY '                   'pen3'Leaving the EDITOR module.'def||CR
      IF notchanged THEN RETURN 0
      IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
        RETURN 1
      CALL DELETE(editarg)
      IF savelines(editarg) THEN RETURN 1
      CALL DELAY(28)
      IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
      SAY pen3'                        Changes saved.'def||CR
      RETURN 0
    END
  ELSE IF edcom='C' THEN  /* Cut */
    DO
      firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
      IF firstnum='' THEN ITERATE edloop
      dash=POS('-',firstnum)
      IF dash>0 THEN
        DO
          lastnum=STRIP(SUBSTR(firstnum,dash+1))
          firstnum=STRIP(LEFT(firstnum,dash-1))
        END
      ELSE lastnum=firstnum
      IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
        DO
          junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
          ITERATE edloop
        END
      IF lastnum>lynes.0 THEN lastnum=lynes.0
      IF firstnum<firstedit THEN
        DO
          SAY '*** You are not authorized to delete that line!'CR
          SAY CR
          ITERATE edloop
        END
      IF firstnum>lastnum THEN
        DO
          SAY '*** Input error!  First number larger than last number.'CR
          ITERATE edloop
        END
      notchanged=0
      numdiff=lastnum+1-firstnum
      pasted.=''
      pasted.0=numdiff
      k=0
      DO i=firstnum TO lynes.0
        j=i+numdiff
        k=k+1
        IF k<=numdiff THEN pasted.k=lynes.i
        lynes.i=lynes.j
        lynes.j=''
      END
      lynes.0=lynes.0-numdiff
      count=1
    END
  ELSE IF edcom='A' THEN  /* append */
    DO
      CALL writebuffer(scratch'/EditorFile')
      notchanged=0
    END
  ELSE IF edcom='U' THEN  /* Upload a textfile to append */
    DO
      CALL txup(1)
      notchanged=0
    END
  ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
    DO
      IF DATATYPE(edcom,'W') THEN
        DO
          ednum=edcom
          edcom='R'
        END
      ELSE
        DO
          line=pen3'   '
          IF edcom='L' | edcom='P' THEN line=line'Starting '
          line=line'Line Number? > 'def
          ednum=getinput(1 0 line)
        END
      IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
      IF ednum>(lynes.0+1) THEN ITERATE edloop
      IF edcom='L' THEN
        DO
          count=ednum
          ITERATE edloop
        END
      IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
        DO
          IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
            DO
              filenum=STRIP(WORD(lynes.1,2))
              num=files.filenum.0
              keywords=edkeywords(editarg)
              lynes.1=LEFT(lynes.1,21) keywords
              alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
              savefileflag=1
              notchanged=0
              ITERATE edloop
            END
        END
      IF ednum<firstedit THEN
        DO
          SAY '*** You are not authorized to alter that line!'CR
          SAY CR
          ITERATE edloop
        END
      IF edcom='R' THEN   /* replace */
        DO
          SAY '   Now reads:'CR
          SAY pen3||RIGHT(ednum,2)||def lynes.ednum||CR
          OPTIONS PROMPT pen3'........Search text? >'def
          PARSE PULL stext
          IF LENGTH(stext)=0 THEN
            DO
              IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
                ITERATE edloop
              lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
              notchanged=0
              ITERATE edloop
            END
          found=POS(UPPER(stext),UPPER(lynes.ednum))
          IF found=0 THEN
            DO
              SAY CR
              SAY stext' was not found!'CR
              SAY CR
              ITERATE edloop
            END
          OPTIONS PROMPT pen3'...Replacement text? >'def
          PARSE PULL rtext
          lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
          lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
          IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
            DO
              PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
              PARSE VAR lynes.3 . 'Lib:' libnam
              filenum=STRIP(filenum)
              newc=files.filenum.0
              libnum=finddirnum(libnam)
              alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
              alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
              alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
              alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
              savefileflag=1
            END
          SAY 'Done.'CR
          SAY CR
          notchanged=0
        END
      ELSE IF edcom='I' THEN  /* insert */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+1
            lynes.j=lynes.i
          END
          lynes.ednum=''
          notchanged=0
          lynes.0=lynes.0+1
          lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def)
        END
      ELSE IF edcom='P' THEN   /* paste */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+pasted.0
            lynes.j=lynes.i
          END
          DO k=1 TO pasted.0
            kk=ednum+k-1
            lynes.kk=pasted.k
          END
          notchanged=0
          lynes.0=lynes.0+pasted.0
        END
    END
END
RETURN 0


editor:
toname=''
msgnum=0
thechosen.=''
PARSE ARG edtype toname msgnum .
IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
ELSE
  DO
    IF edtype='MSG' THEN
      DO
        tempmsgdir=0
        IF DATATYPE(arg,'W') THEN tempmsgdir=arg
        IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
          msgdir=tempmsgdir
        ELSE IF areaselect() THEN RETURN
      END
    lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  END
IF toname='' THEN
  DO
    IF edtype='MAIL' THEN
      DO
        CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
        toname=thechosen.1
      END
    ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
  END
toname=SPACE(toname,1,'_')
toname=cleanstring(1':'toname)
IF toname='' | FIND(exclusion,toname)>0 THEN
  DO
    IF toname='' & edtype='MSG' THEN toname='ALL'
    ELSE toname=sysop
    SAY pen3'*** Re-Addressed to'def toname||CR
  END
IF toname~='ALL' THEN
  DO
    IF toname='BBBBS' THEN toname=sysop
    IF FIND(userlist,toname)=0 THEN
      DO
        IF courtesy='' THEN CALL loadcourtesy()
        IF FIND(courtesy,toname)=0 THEN
          DO
            SAY CR
            SAY bak2' 'toname' is not on the user list! 'def||CR
            IF edtype='MAIL' THEN
              DO
                CALL showuserlist()
                RETURN 0
              END
            ELSE
              DO
                IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
                  DO
                    IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
                      CALL showuserlist()
                    RETURN 0
                  END
              END
          END
      END
  END
IF edtype='MAIL' THEN
  DO
    CALL MAKEDIR(bbspath'EMail/'toname)
    mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  END
ELSE
  DO
    CALL MAKEDIR(msgpath||msgdir)
    mailname=msgpath||msgdir'/'lastwrit+1
  END
lynes.=''
lynes.0=6
IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
lynes.2=' From:' name
IF city~='' THEN lynes.2=lynes.2' - 'city
lynes.3='   To:' toname                       /*  To: toname   MSG # */
IF edtype='MAIL' THEN
  DO
    IF readopen(bbspath||'Users/'toname) THEN
      DO
        CALL READLN(f)
        CALL READLN(f)
        temp=READLN(f)
        CALL CLOSE(f)
        temp=docity(temp)
        IF temp~='' THEN lynes.3=lynes.3' - 'temp
      END
    IF replysubj='|@NEW@|' THEN
      DO
        CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
        replysubj='Welcome to' bbsname
      END
  END
subj=''
IF edtype='REPLY' THEN
  DO
    subj=SUBSTR(forthline,WORDINDEX(forthline,2))
    SAY pen3'Subj:'def subj||CR
    temp=getinput(0 0 'Change the current subject? (Ny) > ')
    IF LENGTH(temp)>3 THEN subj=temp
    ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  END
ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
IF subj='' THEN
  DO
    IF opt='C' THEN subj='FEEDBACK'
    ELSE
      DO
        SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def||CR
        subj=getinput(0 0 pen3': 'def)
      END
  END
IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
IF subj='' THEN subj='?'
lynes.4=' Subj:' subj
lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
lynes.6=INSERT('','',1,74,'=')
IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
DO i=1 TO lynes.0
  SAY lynes.i||CR
END
CALL writebuffer(scratch'/MessageFile')
IF savelines(mailname) THEN RETURN 0
CALL seelines(1)
IF thechosen.0='' THEN
  DO
    thechosen.0=1
    thechosen.1=toname
  END
carbons=thechosen.0+1
DO FOREVER
  IF thechosen.0>=carbons THEN
    DO
      junk='Copies To:'
      DO cci=carbons TO thechosen.0
        junk=junk thechosen.cci
      END
      SAY junk||CR
    END
  pline=''
  IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  junk=getinput(1 1 pline)
  IF junk='E' THEN
    DO
      IF level>sysoplevel THEN firstedit=1
      ELSE firstedit=7
      IF bbsED(firstedit mailname)=2 THEN RETURN 0
      junk='R'
    END
  ELSE IF edtype='MAIL' & junk='C' THEN
    DO
      CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
      junk='R'
    END
  ELSE IF junk='K' THEN
    DO
      IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'CR
      RETURN 0
    END
  ELSE IF junk='U' THEN
    DO
      CALL txup(0 mailname)
      junk='R'
    END
  IF junk='R' THEN
    DO
      CALL readlines(mailname 1)
      CALL seelines(1)
      nonstop=0
    END
  ELSE BREAK
END
IF edtype='MAIL' THEN
  DO
    IF replysubj~='' & readname~='' & LEFT(readname,5)~='BBBBS' & uname~='' & uname~='UNAME' THEN
      DO
        junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ')
        IF junk~='N' THEN
          DO
            arg=bbspath'Email/'name'/'readname
            IF ~readlines(arg 1) THEN CALL savelines(mailname)
          END
      END
    junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
    IF junk='Y' THEN
      DO
        savearg=arg
        arg=getinput(0 0 'Filename: ')
        curdir=PRAGMA('D')
        CALL MAKEDIR(bbspath'EmailFiles/'toname)
        CALL setdir(bbspath'EmailFiles/'toname)
        DO WHILE uload(0)=2
        END
        IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
          DO
            CALL readlines(mailname 1)
            IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
            CALL setdir(curdir)
            CALL DELETE(mailname)
            CALL savelines(mailname)
          END
        ELSE
          DO
            CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
            SAY pen3'*** Upload failed! ***'def||CR
          END
        arg=savearg
      END
    totmail=WORD(data.17,2)
    IF ~DATATYPE(totmail,'W') THEN totmail=1
    ELSE totmail=totmail+1
    data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  END
IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1
CALL readlines(mailname 1)
DO ui=1 TO thechosen.0
  IF thechosen.ui='' THEN ITERATE ui
  IF ui>1 THEN
    DO
      CALL MAKEDIR(bbspath'Email/'thechosen.ui)
      newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
      IF ui<carbons THEN lynes.3='   To:' thechosen.ui
      ELSE
        DO
          lynes.1=lynes.1'  (Carbon Copy)'
          lynes.3='   To:' thechosen.1
        END
      CALL savelines(newname)
      IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
        DO
          CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
          ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
          line2='Copied' WORD(lynes.1,4)
          SAY line2 'to the' thechosen.ui 'file area.'CR
          CALL send2log(line2)
        END
    END
  line=edtype':'lastwrit+1 'at' TIME('C') 'to' thechosen.ui
  IF edtype~='MAIL' THEN
    DO
      IF FIND(userlist,thechosen.ui)>0 THEN
        CALL msgmark(thechosen.ui msgdir lastwrit+1)
      line=line 'in' msg.msgdir
    END
  CALL send2log(line)
  line=edtype 'Sent To' thechosen.ui
  IF edtype='MAIL' THEN
    DO
      IF emailonline>=0 THEN emailonline=emailonline+1
    END
  ELSE
    DO
      grand=grand+1
      IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
      ELSE msg.msgdir.0=msg.msgdir.0+1
      line=line 'in the'pen3 msg.msgdir def'conference.'
    END
  SAY line||CR
END
IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN 1


txup:
PARSE ARG upflg uparg .
SAY 'Ready to append' pen3'TEXT ONLY'def 'using'pen3 protocol||def||CR
pline='Are you SURE your file is un-compressed text? (Ny) > '
IF getinput(1 1 pline)='Y' THEN
  DO
    savearg=arg
    arg='UploadFile'
    curdir=PRAGMA('D')
    CALL setdir(scratch)
    CALL DELETE(arg)
    CALL DELETE('tempfile1')
    IF uload(0)=0 THEN
      DO
        IF upflg=0 THEN
          DO
            ADDRESS COMMAND 'C:copy' uparg 'tempfile1'
            CALL DELETE(uparg)
            ADDRESS COMMAND 'C:join tempfile1 UploadFile AS' uparg
          END
        ELSE IF upflg=1 THEN
          DO
            CALL readlines(arg lynes.0+1)
            notchanged=0
          END
      END
    CALL setdir(curdir)
    arg=savearg
  END
RETURN


msgmark:
PARSE ARG markname markdir markmsg .
IF OPEN(f,bbspath'Users/'markname)=0 THEN RETURN
mlines.=''
DO mi=1 TO 24
  mlines.mi=READLN(f)
END
mlines.24=STRIP(mlines.24 markdir'/'markmsg)
CALL SEEK(f,0,'B')
DO mi=1 TO 24
  CALL WRITELN(f,mlines.mi)
END
CALL CLOSE(f)
RETURN


shell:
SAY CR
olddir=PRAGMA('D')
DO WHILE(UPPER(opt)~='EXIT')
  SAY bak2||TIME('C')||def PRAGMA('D')||CR
  OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  PARSE PULL opt' 'arg
  CALL checkdcd()
  IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  ELSE IF exists(opt)~=0 THEN
    DO
      IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
    END
  ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
    ADDRESS COMMAND opt '<* >*' arg
END
CALL PRAGMA('D',olddir)
RETURN


yell:
chatrequest=1
IF excuses.1='' THEN
  DO
    IF readopen(bbspath'Lists/Excuses') THEN
      DO
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          excuses.i=line
        END
        excuses.0=i-1
        CALL CLOSE(f)
      END
  END
j=TIME('S')//excuses.0+1
SAY CR
SAY 'Sorry, your SysOp,' sysop','CR
IF excuses.j~='' THEN SAY excuses.j||CR
ELSE SAY 'is not available, please leave a ['pen3'C'def']omment.'CR
SAY CR
IF bbsprefs.13 THEN RETURN
SAY 'I''m yelling anyway...'CR
SAY 'If nobody answers, please try again later or leave a ['pen3'C'def']omment'CR
CALL sound('YELL')
IF SHOWLIST('H','SPEAK') THEN  /* check on SPEAK: device */
  DO
    IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */
      ADDRESS COMMAND 'C:Run C:Type >SPEAK:' bbspath'BBS_TEXT/YELL'
    ELSE IF writeopen('SPEAK:')~=0 THEN
      DO
        CALL WRITELN(f,'Yo sissop.')
        CALL WRITELN(f,'A uzer wants to chat with you.')
        CALL WRITELN(f,'Yo sissop.')
        CALL CLOSE(f)
      END
  END
ELSE IF EXISTS(saypath) THEN          /* default to SAY */
  DO
    IF EXISTS(bbspath'BBS_TEXT/YELL') THEN /* we have yell file */
      ADDRESS COMMAND 'C:Run' saypath '-x' bbspath'BBS_TEXT/YELL'
    ELSE
      DO
        ADDRESS COMMAND saypath 'Yo sissop.'
        ADDRESS COMMAND saypath 'A uzer wants to chat with you.'
        ADDRESS COMMAND saypath 'Yo sissop.'
      END
  END
RETURN


/* online change to member. Sysop triggered by BumpMember.baud */
validate:
IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
  DO
    SAY CR
    SAY 'You are being validated.  Please wait...'CR
    SAY CR
    DO lvi=1 TO 22
      line=READLN(f)
      IF lvi=11 THEN data.11=line
      IF lvi=20 THEN data.20=line
      IF lvi=21 THEN data.21=line
    END
    data.22=line
    CALL CLOSE(f)
    CALL SetData()
    CALL sortlibraries()
    CALL logonstats()
    CALL saveData(0)
    SIGNAL RESTART
  END
ELSE MSG bak2'You need a default member file in BBS_TEXT!   ( BBS_TEXT/DEF.MEMBER )'def
RETURN


/* online time change. Sysop triggered by BumpTime.baud */
uptime:
mins=GETCLIP('BBS_minutes')
IF DATATYPE(mins,'N') THEN
  DO
    IF (mins*60)>maxtime THEN
      SAY name', this session''s time has been increased to' mins 'minutes.'CR
    ELSE MSG '*** User has not been told that his time has decreased.'
    CALL SETCLIP('BBS_minutes')
    maxtime=mins*60
  END
RETURN


/* online level change. Sysop triggered by BumpLevels.baud */
uplevel:
levl=GETCLIP('BBS_level')
IF DATATYPE(levl,'W') THEN
  DO
    IF levl>data.20 THEN
      SAY name', your level has been changed from' data.20 'to' levl'.'CR
    ELSE MSG '*** User has not been told his level has been reduced.'
    data.20=levl
    CALL SetData()
    IF menu='NEW' THEN menu='ALL'
    CALL sortlibraries()
  END
RETURN


/* online ratio change. Sysop triggered by BumpLevels.baud */
upratio:
rats=GETCLIP('BBS_ratio')
IF DATATYPE(rats,'W') THEN
  DO
    SAY name', your upload:download ratio has been changed to 1:'rats'.'CR
    data.17=rats'  'WORD(data.17,2)'  'WORD(data.17,3)
    CALL SETCLIP('BBS_ratio')
  END
RETURN


bytes2user:
PARSE ARG indx bytes .
tfiles=WORD(data.indx,1)
tbytes=WORD(data.indx,3)
IF ~DATATYPE(tfiles,'W') THEN tfiles=0
IF ~DATATYPE(tbytes,'W') THEN tbytes=0
tbytes=tbytes+bytes
tfiles=tfiles+1
IF tfiles>1 THEN data.indx=tfiles 'files' tbytes 'bytes.'
ELSE data.indx='1 file' bytes 'bytes.'
data.indx=data.indx DATE()
CALL saveData(0)
RETURN


stats:
ARG indx
tfail=''
bytes=''
Status z
string=RESULT
IF RIGHT(BB_VERS,4)>1.59 THEN
  DO
    PARSE VAR string . 'Local Name: 'temp . 'Xfer''ed: 'bytes . 'Elapsed Time: 'min':'sec'0A'x .
    slash=LASTPOS('/',temp)
    IF slash=0 THEN slash=LASTPOS(':',temp)
    IF slash~=0 THEN temp=SUBSTR(temp,slash+1)
  END
ELSE PARSE VAR string temp' 'min':'sec . 'Bytes:'bytes .
temp=STRIP(temp)
min=STRIP(min)
sec=STRIP(sec)
bytes=STRIP(bytes)
IF temp~='' & LEFT(UPPER(STRIP(temp)),8)~=LEFT(UPPER(arg),8) THEN
  tfail='wrong file' temp
ELSE IF DATATYPE(min,'W') & DATATYPE(sec,'W') & DATATYPE(bytes,'W') THEN
  DO
    secs=(min*60)+sec
    IF indx=14 THEN CALL DELAY(100) /* wait for dos to finish upload */
    temp=STATEF(PRAGMA('D')'/'arg)
    temp=WORD(temp,2)
    IF ~DATATYPE(temp,'W') THEN temp=0
    IF indx=14 & (temp+1024)<bytes THEN tfail='ul size'
    IF indx=15 & temp>(bytes+1024) THEN tfail='dl size'
  END
ELSE tfail='not numeric: min='min 'sec='sec 'bytes='bytes
IF tfail~='' THEN
  DO
    line=plaindir'/'arg pen3'*** Transfer failed! ***'def
    SAY line||CR
    CALL send2log(line 'tfail:'tfail)
    CALL send2log('***' string)
    Remote OFF
    Send '^G\w^G^G'
    Remote ON
    RETURN 1
  END
ELSE IF secs>0 THEN
  Say 'Transfer Speed:' TRUNC(bytes/secs+.05,1) 'characters per second.'CR
Remote OFF
Send '^G'
Remote ON
line=left(arg,16,' ')
IF indx=14 THEN
  DO
    temp=countcheck(bbspath'Numbers/Bytes.UpLoad' 0)+bytes
    CALL countcheck(bbspath'Numbers/Bytes.UpLoad' temp)
    line=line 'uled'
  END
ELSE
  DO
    temp=countcheck(bbspath'Numbers/Bytes.DownLoad' 0)+bytes
    CALL countcheck(bbspath'Numbers/Bytes.DownLoad' temp)
    temp=countcheck(bbspath'Numbers/Files.DownLoad' 0)+1
    CALL countcheck(bbspath'Numbers/Files.DownLoad' temp)
    temp=PRAGMA('D')
    xdev=SPACE(LEFT(temp,POS(':',temp)-1),1,'_')
    tfiles=1
    IF EXISTS(arg'.xdl') THEN
      DO
        IF readopen(arg'.xdl') THEN
          DO
            xdev=READLN(f)
            tfiles=READLN(f)
            CALL CLOSE(f)
          END
      END
    temp=countcheck(bbspath'Numbers/Bytes.X.'xdev 0)+bytes
    CALL countcheck(bbspath'Numbers/Bytes.X.'xdev temp)
    temp=countcheck(bbspath'Numbers/Files.X.'xdev 0)+tfiles
    CALL countcheck(bbspath'Numbers/Files.X.'xdev temp)
    line=line 'dled'
  END
line=line protocol TIME('C') bytes 'bytes' PRAGMA('D')
CALL send2log(line)
RETURN 0


bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >ram:infout' bbsdevice
ok=OPEN(f,'ram:infout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY CR
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
  DO
    line=bbsdevice 'is not an info compatible device!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    bbsk=0
    RETURN
  END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'CR
RETURN


comma:
ARG num .
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
  DO
    numtext=','LEFT(RIGHT(num,12),3)||numtext
    numtext=LEFT(num,dgt-12)||numtext
  END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext


is_here:
ARG newname
SAY 'Checking filelist...'CR
filenum=countcheck(bbspath'Numbers/LastFile' 0)
DO ui=1 TO filenum
  IF UPPER(WORD(files.ui,2))~=newname THEN ITERATE ui
  temp=WORD(files.ui,1)
  line=pen3'*** File' newname 'already exists here in the'
  line=line temp 'directory.'def
  SAY line||CR
  temp=files.ui.0
  IF DATATYPE(temp,'W') THEN SAY alpha.temp||CR
  SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'CR
  RETURN 1
END
CALL cleanline(1)
RETURN 0


uload:
ARG frommenu
IF frommenu THEN
  DO
    SAY CR
    SAY pen3'PLEASE!'def 'Only upload 1 (one) file at a time. NO MULTIPLE UPLOADS! Thanks.'CR
  END
CALL bbsspace(12)
SAY CR
IF bbsk<1 THEN
  DO
    line='Upload area is full!'
    CALL send2log(line)
    SAY pen3||line||def||CR
    RETURN 1
  END
IF arg='' THEN arg=getinput(0 0 'Filename: ')  /* no filename given */
arg=cleanstring('0:'arg)
arg=COMPRESS(arg,' :/,;|#?*')  /* be sure no illegals here */
tempnum=LENGTH(arg)-16
DO WHILE tempnum>0
  temp='          'pen3||arg def'is'pen3 tempnum||def
  IF tempnum=1 THEN temp=temp 'character'
  ELSE temp=temp 'characters'
  temp=temp 'too long for a filename.'
  SAY temp||CR
  arg=getinput(0 0 'Filename: ')
  arg=cleanstring('0:'arg)
  arg=COMPRESS(arg,' :/,;|#?*')
  tempnum=LENGTH(arg)-16
END
IF arg='' THEN RETURN 1
IF frommenu THEN
  DO
    IF is_here(arg) THEN RETURN 1
    IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
    ELSE
      DO loop=1
        SAY 'Please select an appropriate library for -' pen3||arg def'-'CR
        IF chdir()=0 THEN LEAVE loop
      END
  END
checkproto='T'
targ=arg
DO WHILE checkproto='T'
  arg=''
  SAY CR
  SAY 'Library:'pen3 plaindir def'  Filename:'pen3 targ def'  Protocol:'pen3 protocol||def||CR
  pline=' ['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol'
  pline=pline '['pen3'U'def']pload (qtU) > '
  checkproto=getinput(1 1 pline)
  IF checkproto='Q' THEN RETURN 1
  IF checkproto='T' THEN CALL chpro()
END
arg=targ
CALL postuser(4)
uploadtime=TIME('E')
SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
CALL whodat()
DownLoad arg
IF RC>0 | stats(14) THEN RETURN 2
rbytes=WORD(STATEF(arg),2)
IF rbytes<1 THEN
  DO
    CALL DELETE(arg)
    RETURN 2
  END
temp=''
DO WHILE temp~='N' & temp~='Y'
  temp=getinput(1 1 'Received' rbytes 'bytes. Was your upload successful? (ny) > ')
END
IF temp='N' THEN RETURN 2
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  DO
    SAY CR
    SAY pen3'***'def arg pen3'failed archive check!'def||CR
    SAY CR
    temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
    IF temp~='Y' THEN
      DO
        CALL DELETE(arg)
        SAY CR
        RETURN 2
      END
  END
CALL bytes2user(14 rbytes)
ADDRESS AREXX bbsNewFile.rexx name PRAGMA('D')'/'arg
IF bbsprefs.9 & name~=sysop THEN
  DO
    newufile=bbspath'EMail/'sysop'/NEW_FILES'
    IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
    ELSE
      DO
        ok=OPEN(f,newufile,'W')
        IF ok~=0 THEN CALL WRITELN(f,'*** New Files ***')
      END
    IF ok~=0 THEN CALL WRITELN(f,name 'uploaded' plaindir'/'arg'  'DATE() TIME())
    CALL CLOSE(f)
  END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
DO ui=sysoplevel+2 TO 100
  IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0     /* no filenotes */
END
IF frommenu THEN
  DO
    uploadtime=TIME('E')-uploadtime
    IF bbsprefs.11 THEN
      DO
        maxtime=maxtime+uploadtime
        line='This session''s time has been increased by'
        line=line TRUNC(uploadtime%60+.05,1)+1 'minutes.'
        SAY CR
        SAY line||CR
      END
    DO WHILE editnote(arg)  /* INSIST on a filenote */
    END
    SAY pen3'Thank you for contributing to the' bbsname 'file libraries!'def||CR
  END
waitchar=''
RETURN 0


findfiles:
PARSE ARG ffile .
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
IF DATATYPE(ffile,'W') THEN
  DO
    IF WORDS(files.ffile)<2 THEN RETURN 0
    dirtemp=WORD(files.ffile,1)
    IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
      DO
        CALL illegal_access()
        RETURN 0
      END
    CALL setdir(libpath||dirtemp)
  END
ELSE IF EXISTS(ffile) THEN
  DO
    IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
      DO
        IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
          DO
            line=READLN(f)
            CALL CLOSE(f)
            ffile=WORD(line,2)
          END
      END
  END
ELSE
  DO
    nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
    DO ui=nextfilenum TO 0 BY -1
      IF ui<1 THEN
        DO
          SAY CR
          SAY '***' files.0 'filenames scanned,'pen3 ffile def'is not on the filelist!'CR
          SAY CR
          RETURN 0
        END
      argtemp=WORD(files.ui,2)
      IF UPPER(argtemp)=UPPER(ffile) THEN
        DO
          dirtemp=WORD(files.ui,1)
          jj=files.ui.0
          IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
            DO
              CALL illegal_access()
              RETURN 0
            END
          ffile=ui
          CALL setdir(libpath||dirtemp)
          LEAVE ui
        END
    END
  END
ftemp=ffile
IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
IF ~EXISTS(ftemp) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
    IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
    IF ~EXISTS(ftemp) THEN
      DO
        IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'CR
        ELSE
          DO
            SAY CR
            SAY '***'pen3 plaindir'/'ftemp def'is not currently available online.'CR
            SAY 'Please leave email to your sysop'pen3 sysop||def', to receive this file.'CR
            SAY CR
          END
        RETURN 0
      END
  END
RETURN ffile


illegal_access:
SAY CR
SAY '*** You are not authorized to access' ffile'!'CR
SAY '*** Send Email to' sysop 'to receive a higher level.'CR
SAY CR
IF DATATYPE(ffile,'W') THEN ffile=ffile WORD(files.ffile,2)
CALL send2log('Illegal Access Attempt!' ffile 'in' dirtemp)
RETURN


statuscheck:
PARSE ARG ffile
updownratio=WORD(data.17,1)
IF ~DATATYPE(updownratio,'N') THEN updownratio=100
upbytes=WORD(data.14,3)
IF ~DATATYPE(upbytes,'W') | upbytes<1 THEN upbytes=1
dnbytes=WORD(data.15,3)
IF ~DATATYPE(dnbytes,'W') | dnbytes<1 THEN dnbytes=1
dbytes=WORD(STATEF(ffile),2)
IF ~DATATYPE(dbytes,'W') THEN dbytes=1
IF ~DATATYPE(bps,'W') THEN bps=2400
needtime=dbytes%(bps%10)+10  /* plus 10 seconds for handshaking? */
SAY CR
SAY CR
CALL showtime()
SAY 'At least' TRUNC(needtime/60+.05,1) 'minutes needed to download' ffile 'at' bps 'baud.'CR
SAY 'After this transfer your upload:download ratio will be 1:'TRUNC((dbytes+dnbytes)/upbytes)||CR
IF level>(sysoplevel+1) | POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
IF (needtime+TIME('E'))>maxtime THEN
  DO
    SAY CR
    SAY 'Sorry, not enough time left in this session to download' dbytes 'bytes.'CR
    CALL send2log(needtime%60 'mins needed to dl' ffile 'at' dbytes 'bytes!'def)
    IF needtime>(WORD(data.11,1)*60) THEN
      SAY 'Leave email to the sysop to make other arrangements to receive this file.'CR
    SAY CR
    RETURN 1
  END
IF updownloadratio>0 & (dnbytes/upbytes)>updownratio THEN
  DO
    SAY CR
    line=pen3'       *** You must upload before you do any more downloading! ***'def
    SAY line||CR
    CALL send2log('*** Exceeded Download Ratio 1:'TRUNC(dnbytes/upbytes))
    SAY '  Maintain a ratio of at least 1 byte uploaded for each' updownratio 'bytes downloaded.'CR
    IF bbsprefs.4 THEN RETURN 1
    SAY pen3'             - This requirement is temporarily suspended. -'def||CR
    SAY CR
  END
RETURN 0


ext_dload:
SAY CR
CALL checkdcd()
allargs=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
IF allargs='' | TRUNC(maxtime-TIME('E'))<30 THEN RETURN
CALL dload2()
RETURN


dload:
arg=STRIP(arg data.25)
data.25=''
curdir=PRAGMA('D')
OPTIONS PROMPT 'Filenames and/or numbers: '
IF arg='' THEN PARSE PULL arg  /* no filename given */
IF arg='' THEN RETURN 0
allargs=TRANSLATE(arg,'     ',':/,;|')
tempargs=SPACE(allargs,1)
SAY 'Working...'lineup||CR
IF POS('EMAILFILES',curdir)=0 THEN
  DO di=1 TO WORDS(tempargs) WHILE STRIP(allargs)~=''
    arg=WORD(tempargs,di)
    wloc=WORDINDEX(allargs,FIND(allargs,arg))
    temp=findfiles(arg)
    IF temp~=arg THEN
      DO
        allargs=DELWORD(allargs,FIND(allargs,arg),1)
        IF temp~=0 THEN allargs=INSERT(temp' ',allargs,wloc-1)
      END
  END

dload2:
curdir=PRAGMA('D')
allargs=STRIP(data.25 allargs)
data.25=''
IF allargs='' THEN RETURN 0
sleepy='T'
DO WHILE sleepy='T'
  arg=''
  SAY CR
  temp=WORD(allargs,1)
  IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
  test=''
  IF LENGTH(temp)>40 THEN
    DO
      test=temp
      temp=''
    END
  SAY 'Filename(s)'pen3 LEFT(temp,40) def'Protocol:'pen3 protocol||def||CR
  IF test~='' THEN SAY '           'pen3 test||def||CR
  DO di=2 TO WORDS(allargs) /* emailfile will not get here */
    temp=WORD(allargs,di)
    IF DATATYPE(temp,'W') THEN temp=WORD(files.temp,2)
    SAY '           'pen3 temp||def||CR
  END
  pline='['pen3'A'def']uto-Logoff-after-transfer ['pen3'D'def']ownload'
  pline=pline '['pen3'Q'def']uit ['pen3'T'def']ransfer-protocol (aDqt)'
  sleepy=getinput(1 1 pline '> ')
  IF sleepy='Q' THEN RETURN 0
  IF sleepy='A' THEN sleepy='LOGOFF'
  IF sleepy='T' THEN CALL chpro()
END
DO WHILE allargs~=''
  errorflag=0
  extdir=''
  arg=WORD(allargs,1)
  allargs=STRIP(DELWORD(allargs,1,1))
  IF DATATYPE(arg,'W') THEN
    DO
      CALL setdir(libpath||WORD(files.arg,1))
      arg=WORD(files.arg,2)
    END
  notename=bbspath'FileNotes/'plaindir'/'arg
  finfo=''
  IF ~EXISTS(arg) THEN
    DO
      finfo=STATEF(notename)
      IF WORDS(finfo)>7 THEN
        DO
          temp=plaindir
          x=lastslash(WORD(finfo,8))
          arg=WORD(x,1)
          CALL setdir(WORD(x,2))
          plaindir=temp
        END
    END
  x=lastslash(arg)
  IF WORDS(x)>1 THEN
    DO
      arg=WORD(x,1)
      extdir=WORD(x,2)
      CALL setdir(extdir)
    END
  DO dloadloop=1
    IF statuscheck(arg) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL postuser(5)
    SAY 'Starting' protocol 'transfer.  Press' pen3'Esc'def 'to abort.'CR
    CALL checktime()
    UpLoad arg
    IF RC>0 | stats(15) THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    CALL bytes2user(15 WORD(STATEF(arg),2))
    IF extdir='' & POS('EMAILFILES',UPPER(PRAGMA('D')))=0 THEN
      DO dloadloop2=1 TO 1
        DO di=sysoplevel+2 TO 100
          IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop2
        END
        IF readlines(notename 1) THEN
          DO
            CALL send2log('Unable to increment download count for' plaindir'/'arg)
            LEAVE dloadloop2
          END
        dls=WORD(lynes.2,7)
        IF ~DATATYPE(dls,'W') THEN dls=0
        lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
        finfo=STATEF(notename)
        IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
        ELSE finfo=''
        CALL DELETE(notename)
        CALL savelines(notename)
        CALL DELAY(28)
        IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' notename finfo
        IF WORD(data.16,1)<WORD(lynes.1,2) THEN
          DO
            lastbrowse=WORD(lynes.1,2)
            newfilesdate=DATE('S') TIME()
          END
      END
    LEAVE dloadloop
  END
END
CALL setdir(curdir)
IF errorflag THEN SAY pen3'*** Download Failed!'def||CR
IF sleepy='LOGOFF' THEN
  DO
    SAY CR
    SAY 'Logging'pen3 'OFF' def'in 10 seconds...'CR
    SAY 'Press'pen3 RETURN def'to return to'pen3 bbsname||def||CR
    SAY CR
    Timeout 10
    WAIT '?'
    IF RC~=0 THEN SIGNAL LOGOUT2
    Timeout maxidle
  END
RETURN errorflag


lastslash:
PARSE ARG sarg
sdir=''
slash=LASTPOS('/',sarg)
IF slash>2 THEN sdir=LEFT(sarg,slash-1)
ELSE
  DO
    slash=LASTPOS(':',sarg)
    IF slash>0 THEN sdir=LEFT(sarg,slash)
  END
IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
RETURN sarg sdir


editnote:
IF arg='' THEN
  DO
    PARSE PULL arg .
    IF arg='' THEN RETURN 0
  END
comment=''
IF ~EXISTS(arg) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
    temp=''
    IF WORDS(finfo)>7 THEN comment=WORD(finfo,8)
    ELSE
      DO
        IF level<sysoplevel THEN RETURN 0
        temp=getinput(1 1 'Is this file on an another device? (Nqy)')
      END
    IF temp='Y' THEN
      DO WHILE comment=''
        OPTIONS PROMPT 'Enter linkfile using full dev:path/filename > '
        PARSE PULL comment
        comment=STRIP(comment)
        IF comment='' THEN RETURN 0
        IF ~EXISTS(comment) THEN comment=''
      END
    ELSE IF temp='Q' THEN RETURN 0
  END
IF comment='' THEN
  DO
    arg=findfiles(arg)
    IF arg=0 THEN RETURN 0
    IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
  END
filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  DO
    SAY pen3'*** Failed to open directory!' filedir||def||CR
    RETURN 0
  END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
  DO
    IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
    CALL bbsED(firstedit notename)
    RETURN 0
  END
IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
ELSE filedata=STATEF(comment)
IF filedata='' THEN
  DO
    IF comment='' THEN line=filedir'/'arg
    ELSE line=comment
    SAY line 'does not exist!'CR
    RETURN 0
  END
bytes=WORD(filedata,2)
filenum=filenum+1
lynes.0=4
lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
lynes.4=INSERT('','',1,74,'=')
lynes.1=lynes.1 edkeywords(arg filedir)
CALL seelines(1)
edtype=''
CALL writebuffer(scratch'/NoteFile')
IF savelines(notename) THEN RETURN 0
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
fncom='R'
DO WHILE fncom='R'
  CALL seelines(1)
  nonstop=0
  line='['pen3'E'def']dit'
  IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  IF level>sysoplevel THEN line=line '(ekrS) 'def
  ELSE line=line '(erS) 'def
  fncom=getinput(1 1 line)
  IF fncom='K' & level>sysoplevel THEN
    DO
      SAY 'Killing FileNote..'CR
      CALL DELETE(notename)
      RETURN 1
    END
  ELSE IF fncom='E' THEN
    DO
      IF bbsED(firstedit notename)>0 THEN RETURN 0
      fncom='R'
    END
  ELSE IF fncom~='R' THEN
    DO
      SAY 'Adjusting filelist...'CR
      IF filenum<1 THEN filenum=1
      IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',1)
      CALL countcheck(bbspath'Numbers/LastFile' filenum)
      files.0=files.0+1
      newcount=alpha.0+1
      alpha.0=newcount
      files.filenum=plaindir arg
      files.filenum.0=newcount
      libnum=finddirnum(plaindir)
      PARSE VAR lynes.1 . 'KeyWords:' keywords
      alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
      alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
      alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
      alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
      IF EXISTS(bbspath'Lists/Files') THEN
        x=OPEN(f,bbspath'Lists/Files','A')
      ELSE x=OPEN(f,bbspath'Lists/Files','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files'CR
          RETURN 0
        END
      CALL WRITELN(f,filenum files.filenum)
      CALL CLOSE(f)
      IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
        x=OPEN(f,bbspath'Lists/Files.ALPHA','A')
      ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'CR
          RETURN 0
        END
      CALL WRITELN(f,alpha.newcount)
      CALL CLOSE(f)
      sortalphaflag=1
      savefileflag=1
      CALL cleanline(1)
    END
END
RETURN 0


edkeywords:
PARSE ARG kwarg
SAY CR
SAY pen3'Please enter a list of keywords (or a condensed description)'def||CR
SAY pen3'to be used in the alphabetic list and by the search routine.'def||CR
SAY '    Note that only the first 31 characters will be used.'CR
SAY INSERT('','',1,74,'=')||CR
templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
templine=cleanstring('0:'templine)
SAY CR
RETURN STRIP(LEFT(templine,32))


loadfiles:
SAY def||CR
SAY 'Loading filelist...'CR
files.=''
files.0=0
IF readopen(bbspath'Lists/Files') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
    END
    files.0=i-1
    CALL CLOSE(f)
  END
RETURN


savefilelist:
IF level=99 THEN
  IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN

savefilelist2:
SIGNAL OFF BREAK_E
IF ckmaint('FILES') THEN RETURN
CALL savealphalist()
SAY 'Saving filelist...'CR
CALL SETCLIP('BBS_maint',1)
xarg=bbspath'Lists/Files'
CALL DELETE(xarg)
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF filenum<1 | writeopen(xarg)=0 THEN RETURN
DO i=1 TO filenum
  IF files.i='' THEN ITERATE i
  CALL WRITELN(f,i files.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
savefileflag=0
IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
RETURN


loadalpha:
SAY def||CR
SAY 'Loading the alphabetical filelist...'CR
IF readopen(bbspath'Lists/Files.ALPHA') THEN
  DO
    alpha.=''
    alpha.0=0
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      fnum=WORD(line,3)
      IF DATATYPE(fnum,'W') THEN
        DO
          alpha.i=line
          files.fnum.0=i
        END
      ELSE i=i-1
    END
    CALL CLOSE(f)
    alpha.0=i-1
    IF alpha.0<files.0 THEN buildalpha=1
  END
ELSE SAY pen3'*** Lists/Files.ALPHA failed to open for reading!'def||CR
SAY CR
RETURN


ckmaint:
ARG ckfile .
IF GETCLIP('BBS_maint')~='' THEN
  DO
    DO i=0 TO 23 WHILE GETCLIP('BBS_maint')~=''
      IF i//2=0 THEN SAY 'Waiting' (24-i)*5 'more seconds for' ckfile 'list update to finish...'CR
      CALL DELAY(250)
    END
    IF i>23 THEN
      DO
        line='*** unable to update' ckfile 'list.'
        CALL send2log(line DATE() TIME('C'))
        SAY line||CR
        RETURN 1
      END
  END
RETURN 0


savealphalist:
SIGNAL OFF BREAK_E
IF ckmaint('ALPHA') THEN RETURN
CALL SETCLIP('BBS_maint',1)
IF GETCLIP('BBS_localfiles')~='' THEN
  DO
    CALL SETCLIP('BBS_localfiles')
    CALL loadfiles()
    CALL loadalpha()
  END
aarg=bbspath'Lists/Files.ALPHA'
CALL DELETE(aarg)
IF sortalphaflag=1 THEN
  DO
    SAY 'Alphabetizing' alpha.0 'files...'CR
    CALL QSORT(1,alpha.0,alpha)
    DO i=1 TO alpha.0
      fnum=WORD(alpha.i,3)
      files.fnum.0=i
    END
  END
sortalphaflag=0
IF writeopen(aarg)=0 THEN
  DO
    SAY '*** Error opening' aarg '!'CR
    RETURN
  END
SAY 'Saving alphabetical filelist...'CR
DO i=1 TO alpha.0
  ii=WORD(alpha.i,3)
  IF files.ii='' THEN alpha.i='0 0' ii '100'
  IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
ADDRESS AREXX bbsALPHA.rexx SUBSTR(extension,2) arccom
RETURN


viewuser:
SAY CR
SAY bak2' 'name' 'def||CR
DO i=1 TO 18
  stuff=data.i
  IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
  SAY RIGHT(i,2)||pen3 text.i||def':' stuff||CR
END
CALL waiting()
RETURN


edituser:
IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
  DO
    SAY CR
    SAY pen3'     - Message Conference Access -'def||CR
    SAY '[O]ff turns all message conferences OFF.'CR
    SAY 'Set the last message read by you in ALL message conferences'CR
    temp=getinput(1 1 ' ['pen3'L'def']ast  ['pen3'F'def']irst  ['pen3'O'def']ff  ['pen3'Q'def']uit  (fLoq) > ')
    IF temp='Q' THEN RETURN
    SAY 'Resetting...'lineup||CR
    data.22=''
    DO i=1 TO level
      IF temp='F' THEN num=0
      ELSE IF temp='O' THEN num=-1
      ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0)
      data.22=data.22 num
    END
    CALL SetData()
    CALL sortconferences()
    CALL savedata(1)
    RETURN
  END
new=0
change=0
edata.=''
edname=name
DO i=0 TO data.0
  edata.i=data.i
END
num=1
DO WHILE num~='' | edname~=name
  IF num='' THEN
    DO
      IF change THEN
        DO
          CALL SetData()
          CALL saveData(1)
          change=0
        END
      IF new THEN
        DO
          data.=''
          DO i=0 TO edata.0
            data.i=edata.i
          END
          name=edname
          new=0
        END
      CALL SetData()
    END
  maxnum=10
  IF edata.20>sysoplevel THEN maxnum=20
  IF edata.20=99 THEN maxnum=24
  SAY bak2' 'name' 'def||CR
  maxlines=21
  IF maxnum=10 THEN maxlines=20
  DO i=1 TO maxlines
    IF i=5 & name~=edname & edata.20<99 THEN ITERATE
    SAY RIGHT(i,2)||pen3 text.i||def':' data.i||CR
  END
  IF edata.20>sysoplevel THEN
    DO
      line=LEFT(' ',50)
      IF name=edname THEN line=line'NEW = Change User.'
      line=pen3||line||def||lineup
      SAY line||CR
    END
  num=getinput(1 0 'Select Line Number To Edit: ')
  IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
    DO
      new=1
      IF change THEN
        DO
          CALL SetData()
          CALL saveData(1)
        END
      change=0
      nufile=bbspath'Lists/NEW_USERS'
      IF EXISTS(nufile) THEN
        IF ~readlines(nufile 1) THEN CALL seelines(0)
      savename=name
      name=getinput(1 0 'New User Name: 'def)
      name=cleanstring(1':'name)
      IF loadData()=0 THEN name=savename
      IF data.20>=edata.20 THEN
        DO
          SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
          name=savename
          CALL loadData()
        END
    END
  ELSE IF DATATYPE(num,'W') & num>0 THEN
    DO
      IF num>maxnum THEN
        DO
          SAY CR
          SAY pen3'You are not authorized to change that information!'def||CR
          SAY CR
        END
      ELSE
        DO dummy=1 TO 1
          IF num=8 THEN
            DO
              SAY CR
              SAY 'Use spaces to separate options.'CR
              SAY 'If the option word is in line 8, it is ON.'CR
              SAY 'Valid Options:'CR
              SAY '        COLOR  turns ANSI color codes ON.'CR
              SAY '        MENU   combines all main commands into 1 menu.'CR
              SAY '        MENUS  splits main commands into 3 menus.'CR
              SAY '        PHONE  makes your phone number public.'CR
              SAY '        QUICK  activates offline options. See bbsQUICK.DOC'CR
              SAY '        STREET makes your street address public.'CR
              SAY '        TERSE  skips some of the logon procedures.'CR
              SAY CR
            END
          line=RIGHT(num,2)||pen3 text.num||def': '
          SAY line||data.num||CR
          temp=getinput(0 0 line)
          IF temp='' THEN
            DO
              IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
              IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
            END
          IF num=5 | num=8 THEN temp=UPPER(temp)
          IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN
            temp=data.20
          IF edata.20>sysoplevel & name~=edname THEN line2=name' '
          ELSE line2=''
          IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
          line=text.num':' data.num pen6'CHANGED TO'def temp
          CALL send2log(line2||line)
          data.num=temp
          SAY line||CR
          SAY CR
          change=1
        END
    END
END
IF change THEN
  DO
    CALL SetData()
    CALL saveData(1)
  END
RETURN


getnumber:
PARSE ARG tprompt
tnum=getinput(1 0 '  'tprompt' > ')
mask=COMPRESS(XRANGE(),'0123456789')
tnum=COMPRESS(tnum,mask)
IF ~DATATYPE(tnum,'W') THEN tnum=0
tnum=tnum%1
IF tnum>0 & tnum<10 THEN tnum='0'tnum
RETURN tnum


getbirth:
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  Birthday:'
SAY pen3'Please enter your birthday.'def||CR
month=getnumber('month: (1-12)')
day=getnumber('  day: (1-31)')
year=getnumber(' year:       ')
IF year<100 THEN year=year+1900
born=year||month||day
IF born<18750101 | born>(DATE('S')-50000) THEN   /* must be older than 4 */
  DO
    born=''
    IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
      CALL getbirth()
  END
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  'WORD(data.12,3)' 'WORD(born,1)
RETURN


getname:
CALL showuserlist()
SAY CR
pline='Please enter your full Email name : '
name=getinput(1 0 pline)
IF name='' THEN
  DO
    name=getinput(1 0 pline)
    IF name='' THEN
      DO
        SAY 'No name, no entry.  Bye!'CR
        SIGNAL DONE
      END
  END
name=cleanstring(1':'name)
IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN
  DO
    SAY 'Sorry! That name is taken. Please try again.'CR
    RETURN 1
  END
RETURN 0


/** see if name is in data */

checkUser:
tries=0
IF name='NEW' THEN
  DO
    name=''
    DO WHILE getname()
    END
    CALL postuser(7)
  END
IF FIND(userlist,name)=0 THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
      DO
        nonstop=0
        CALL readlines(bbspath'BBS_TEXT/NEW' 1)
        CALL seelines(0)
        CALL waiting()
      END
    SAY CR
    IF getinput(1 1 'Do you want to register? (nY) > ')='N' THEN
      DO
        SAY 'Thanks anyway, bye!'CR
        line=name 'did not want to register.'
        SIGNAL OUT2
      END
    defile=bbspath'BBS_TEXT/DEF.NEW_USER'
    CALL loadcourtesy()
    wordnum=FIND(courtesy,name)
    IF wordnum>0 THEN
      DO
        SAY name', is on the Courtesy List. You will be granted immediate access.'CR
        courtesy=STRIP(DELWORD(courtesy,wordnum,1))
        IF writeopen(bbspath'Lists/Courtesy') THEN
          DO
            DO i=1 TO WORDS(courtesy)
              CALL WRITELN(f,WORD(courtesy,i))
            END
            CALL CLOSE(f)
          END
        defile=bbspath'BBS_TEXT/DEF.COURTESY'
      END
    ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'CR
    IF readlines(defile 1) THEN SIGNAL DONE
    CALL sound('NEW_USER')
    data.=''
    data.0=24
    DO i=6 TO 22
      data.i=lynes.i
    END
    data.12=DATE('S')'  'TIME('C')
    data.13=data.12
    lastondate=DATE('I')-1
    lastontime=TIME('C')
    x=FIND(UPPER(data.8),'COLOR')
    test=getinput(1 1 'Does your terminal handle' pen3'ANSI color'def 'codes? (nY) > ')
    IF test='N' THEN
      DO
        IF x>0 THEN data.8=DELWORD(data.8,x,1)
        CALL colors(0)
      END
    ELSE IF x=0 THEN
      DO
        data.8=data.8 'COLOR'
        CALL colors(1)
      END
    SAY 'Please enter the password you would like to use here.'CR
    data.5=getinput(1 0 'Password: ')
    IF data.5='' THEN
      DO
        line=''name 'refused to enter a password.'
        SIGNAL DONE
      END
    data.1=''
    DO WHILE data.1=''
      data.1=getinput(0 0 'Full Name: ')
      IF data.1='' THEN SAY 'You MUST leave your real name!'CR
    END
    data.2=getinput(0 0 'Street: ')
    data.3=getinput(0 0 'City, State Zip: ')
    data.4=''
    DO WHILE data.4=''
      data.4=getinput(0 0 'Phone: ')
      IF data.4='' THEN
        SAY sysop 'MUST be able to reach you by phone to validate you!'CR
    END
    CALL getbirth()
    IF bbsprefs.8 THEN
      DO
        newufile=bbspath'Lists/NEW_USERS'
        IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
        ELSE
          DO
            ok=OPEN(f,newufile,'W')
            IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
          END
        IF ok~=0 THEN CALL WRITELN(f,DATE() TIME() name' = 'data.1'   'data.4)
        CALL CLOSE(f)
      END
    data.9=getinput(0 0 'Computer: ')
    data.10=getinput(0 0 'Interests: ')
    test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'STREET'
    test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'PHONE'
    IF bbsprefs.7>0 THEN
      DO
        data.20=bbsprefs.7
        data.11='60 minutes' bbsprefs.16-1 'more times today'
      END
    SAY CR
    IF data.20=0 THEN
      SAY 'Thank you, the sysop will give you higher access soon.'CR
    SAY 'Please feel free to leave additional info by using [C]omment.'CR
    SAY CR
    CALL SetData()
    CALL saveData(1)
    SAY 'Adding' name 'to the user list...'CR
    newpassword=data.5
    sortuserflag=1
    temp=countcheck(bbspath'Numbers/Users' 0)+1
    CALL countcheck(bbspath'Numbers/Users' temp)
    CALL DELETE(bbspath'Lists/USERS')
  END
ELSE
  DO
    IF loadData()=0 THEN SIGNAL DONE
    PARSE VAR data.11 amins . atimes .
    lastondate=DATE('I',WORD(data.13,1),'S')
    lastontime=WORD(data.13,2)
    IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=bbsprefs.16
    IF level=99 THEN amins=120
    data.13=DATE('S')'  'TIME()
    data.11=amins 'minutes' atimes-1 'more times today'
    IF atimes<1 & DATE('I')=lastondate THEN
      DO
        SAY CR
        SAY CR
        line= 'Too many calls today.   Call tomorrow.'
        SAY line||CR
        SAY CR
        SAY CR
        CALL send2log(line)
        SIGNAL LOGOUT
      END
    data.13=DATE('S')'  'TIME('C')
    SAY pen3'Password will'def 'NOT' pen3'be echoed.'def||CR
    SAY CR
    passprompt='Enter Password: '
    DO tries=1 TO 3
      Send passprompt
      Remote OFF
      OPTIONS PROMPT ''
      newpassword=getinput(1 0 '')
      Remote ON
      IF(password=newpassword) THEN
        DO
          SAY ''CR
          LEAVE tries; /* correct password */
        END
      IF tries=3 THEN
        DO             /* 3 tries, hang up */
          SAY ''CR
          SAY 'Access terminated.'CR
          line='*** Bad password ***' newpassword '***'
          SAY line||CR
          city=line
          CALL postuser(6)
          SIGNAL OUT2
        END
      SAY ''lineup'                                 'CR
      passprompt='Incorrect.  Password: ' /* ask again */
    END
  END
SAY CR

/* Uncomment section below to have name announced at logon. */
/*
IF SHOWLIST('H','SPEAK') THEN
  DO
    IF writeopen('SPEAK:')~=0 THEN
      DO
        CALL WRITELN(f,'Yo sissop.')
        CALL WRITELN(f,name 'has logd awn.')
        CALL CLOSE(f)
      END
  END
ELSE IF EXISTS(saypath) THEN
  DO
    ADDRESS COMMAND saypath 'Yo sissop.'
    ADDRESS COMMAND saypath name 'logd awn.'
  END
*/
RETURN


saveData:
ARG messflag .
IF data.5='' THEN RETURN
temp=GETCLIP(name'_UPDATE')
IF temp~='' THEN
  DO
    CALL SETCLIP(name'_UPDATE')
    PARSE VAR temp upfiles' 'upbytes' 'upmail' 'upmsg
    IF upfiles>0 THEN
      DO
        files=WORD(data.14,1)
        bytes=WORD(data.14,3)
        IF DATATYPE(files,'W') THEN upfiles=upfiles+files
        IF DATATYPE(bytes,'W') THEN bytes=upbytes
        data.14=upfiles 'files' bytes 'bytes.' DATE()
      END
    IF upmail>0 THEN
      DO
        mail=WORD(data.17,2)
        IF DATATYPE(mail,'W') THEN upmail=upmail+mail
        data.17=WORD(data.17,1) upmail WORD(data.17,3)
      END
    IF upmsg~='' THEN
      DO
        temp=data.23
        DO i=1 TO level
          msg=WORD(temp,i)
          IF ~DATATYPE(msg,'W') THEN msg=0
          IF FIND(upmsg,i) THEN msg=msg+1
          data.23=data.23 msg
        END
      END
  END
SAY 'Updating...             'lineup||CR
SIGNAL OFF BREAK_E
Status Trans
data.6=STRIP(RESULT)
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
  DO
    IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
    ELSE data.16=DATE('S') TIME()
    data.16=lastbrowse data.16
  END
IF messflag THEN
  DO
    userexclude.=0
    DO si=1 TO WORDS(data.22)
      IF WORD(data.22,si)=-1 THEN userexclude.si=1
    END
    data.22=''
    data.23=''
    DO si=1 TO level
      IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
      IF userexclude.si THEN data.22=data.22 '-1'
      ELSE data.22=data.22 lastread.si
      IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
      data.23=data.23 totwrit.si
    END
  END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
IF data.0<26 THEN data.0=26
DO i=1 TO data.0
  CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'CR
RETURN


loadData:
IF name='' THEN RETURN 0
IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
data.=''
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK
  data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

setData:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
level=data.20
DO i=1 TO level
  lastread.i=WORD(data.22,i)
  IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
  totwrit.i=WORD(data.23,i)
  IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
END
password=data.5
IF data.6='' THEN
  DO
    Status Trans
    data.6=RESULT
  END
ELSE
  DO
    IF RIGHT(UPPER(data.6),2)='-G' THEN data.6='G'
    IF RIGHT(UPPER(data.6),3)='-1K' THEN data.6='K'
    IF LEFT(UPPER(data.6),1)='A' THEN data.6='Z'
    Set UPPER(LEFT(data.6,1))
  END
IF ~DATATYPE(data.7,'W') THEN data.7=20
IF data.7<5 THEN data.7=5
linesperpage=data.7
IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
ELSE terseflag=0
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
menu='ALL'
IF FIND(UPPER(data.8),'MENUS')>0 THEN
  DO
    menuflag=1
    menu='MAIN'
  END
ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
ELSE menuflag=0
IF level=0 THEN menu='NEW'
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60
RETURN 1


switchmenuflag:
IF menuflag=1 THEN
  DO
    menuflag=0
    noff='OFF'
  END
ELSE
  DO
    menuflag=1
    noff='ON'
  END
SAY 'Menus turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'CR
RETURN


switchcolors:
IF colorflag=1 THEN
  DO
    colorflag=0
    noff='OFF'
  END
ELSE
  DO
    colorflag=1
    noff='ON'
  END
CALL colors(colorflag)
SAY 'Color turned' pen3||noff||def'.'CR
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'CR
RETURN


/* ANSI pen color codes */
colors:
ARG onoff
IF onoff THEN
  DO
    lineup='1B'x'M'
    def='';  /* default */
    pen0='';  pen1='';  pen2='';  pen3=''
    pen4='';  pen5='';  pen6='';  pen7=''
    bak0='';  bak1='';  bak2='';  bak3=''
    bak4='';  bak5='';  bak6='';  bak7=''
  END
ELSE
  DO
    pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
    bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
    def='';  lineup=''
  END
RETURN


chpro:
arg=UPPER(LEFT(arg,1))
IF(arg='') THEN
  DO
    SAY CR
    SAY '['pen3'W'def']- WXModem'CR
    SAY '['pen3'X'def']- XModem-CRC'CR
    SAY '['pen3'K'def']- XModem-1K'CR
    SAY '['pen3'Y'def']- YModem'CR
    SAY '['pen3'G'def']- YModem-G'CR
    SAY '['pen3'Z'def']- ZModem'CR
/* IF RIGHT(BB_VERS,4)>1.59 THEN SAY '['pen3'R'def']- Kermit'CR */
    SAY CR
    arg=getinput(1 0 STRIP(protocol) '> ')
 END
IF LEFT(UPPER(arg),1)='A' THEN arg='Z'
Set arg
Status Transfer
protocol=STRIP(RESULT)
SAY protocol||CR
RETURN


sortinfofiles:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
  DO
    SAY CR
    SAY pen3'No files are currently in the Information drawer.'def||CR
    SAY CR
    RETURN 1
  END
IF ~DATATYPE(sortinfo.0,'W') THEN
  DO
    info.=''
    sortinfo.=''
    info.0=WORDS(infolist)
    DO i=1 TO info.0
      info.i=WORD(infolist,i)
    END
    SAY 'Sorting..'CR
    CALL QSORT(1,info.0,info)
    sortinfo.0=info.0%3
    IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
    DO i=1 TO sortinfo.0
      sortinfo.i=''
      DO j=0 TO 2
        k=i+j*sortinfo.0
        IF k<=info.0 THEN
          DO
            sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
            infocount=WORD(STATEF(bbspath'Information/'info.k),8)
            sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
          END
      END
    END
    SAY lineup'         'lineup||CR
  END
RETURN 0


information:
IF sortinfofiles() THEN RETURN
SAY pen3'These text files are available for reading online...'def||CR
num=1
readcount=-1
DO infoloop=1
  IF num=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          sortinfo.0=''
          IF sortinfofiles() THEN RETURN
        END
      SAY CENTER('- Number of accesses per file -',75)||CR
    END
  SAY pen3||LEFT('-',75,'-')||def||CR
  IF num=0 THEN
    DO i=1 TO sortinfo.0
      SAY sortinfo.i.0||CR
    END
  ELSE
    DO i=1 TO sortinfo.0
      SAY sortinfo.i||CR
    END
  CALL checktime()
  IF num=0 THEN
    DO
      CALL waiting()
      num=1
      ITERATE infoloop
    END
  num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
  IF num=0 THEN ITERATE infoloop
  IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
  readcount=STATEF(bbspath'Information/'info.num)
  readbytes=WORD(readcount,2)
  readcount=WORD(readcount,8)
  IF ~DATATYPE(readcount,'W') THEN readcount=0
  SAY '  'info.num 'is' readbytes 'bytes.'CR
  SAY 'Loading File...'CR
  ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1
  CALL readlines(bbspath'Information/'info.num 1)
  CALL cleanline(0)
  SAY lineup'    'lynes.0 'lines.'CR
  SAY CR
  CALL seelines(0)
  CALL showtime()
  IF waitchar~='Q' THEN CALL waiting()
  nonstop=0
END
RETURN


newfiles:
SAY CR
test=''
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
  IF chdir()>0 THEN RETURN
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'CR
lastbrowz=WORD(data.16,1)
lastfileup=countcheck(bbspath'Numbers/LastFile' 0)
IF lastbrowz>=lastfileup THEN
  DO
    lastbrowz=0
    SAY pen3'No new files. Listing backwards by date from last file uploaded...'def||CR
  END
ELSE newfilesflag=1
j=0
IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
DO ni=lastfileup TO lastbrowz+1 BY -1
  IF files.ni~='' THEN
    DO
      IF test='Y' THEN
        DO
          IF j>=filecount THEN LEAVE ni
          IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
            ITERATE ni
        END
      jj=files.ni.0
      IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
        ITERATE ni  /* unauthorized */
      j=j+1
      IF j=1 THEN CALL fileheader()
      SAY alpha.jj||CR
      IF (j+2)//(linesperpage-1)=0 THEN
        IF waiting2() THEN LEAVE ni
    END
END
IF j//linesperpage~=0 THEN CALL waiting()
IF test~='Y' THEN
  DO
    CALL newinfo()
    IF lynes.0>0 THEN CALL waiting()
  END
nonstop=0
RETURN


newinfo:
lynes.=''
lynes.0=0
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
startline=1
arg=bbspath'Information'
IF WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF('ram:dirlist'),2)>3 THEN
      DO
        lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
        CALL readlines('ram:dirlist' startline+1)
      END
  END
arg=bbspath'Profiles'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >ram:dirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF('ram:dirlist'),2)>3 THEN
      DO
        startline=lynes.0+2
        lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
        CALL readlines('ram:dirlist' startline+1)
      END
  END
arg=bbspath'rexxDoors/Data/Polls'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    startline=lynes.0+2
    lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
    lynes.0=startline
  END
IF logonflag=1 THEN nonstop=1
IF lynes.0>0 THEN CALL seelines(1)
nonstop=0
RETURN


areaselect:
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO msgs.0
  SAY msgs.i||CR
  IF i//linesperpage=0 THEN CALL waiting()
END
temp=getinput(1 0 pen3'Select Message Conference: 'def)
IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
msgdir=temp
RETURN 0


chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def||CR
DO i=1 TO libs.0
  SAY libs.i||CR
END
dirnum=getinput(1 0 pen3'Select Library Number: 'def)
IF ~DATATYPE(dirnum,'W') THEN
  DO
    waitchar=dirnum
    RETURN 2
  END

chdir2:
IF dirnum<1 | dirnum>99 THEN
  DO
    waitchar=dirnum
    RETURN 1
  END
IF dirs.dirnum='' THEN
  DO
    SAY pen3'That library number is currently un-assigned.'def||CR
    RETURN 1
  END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  DO
    SAY pen3'You do not have authorization for that library!'def||CR
    RETURN 1
  END
IF dirs.dirnum~='' THEN
  DO
    CALL MAKEDIR(libpath||dirs.dirnum)
    CALL setdir(libpath||dirs.dirnum)
  END
RETURN 0


since:
dm=DATE(,WORD(data.16,2),'S')
SAY CR
SAY 'New files or files moved since' dm||CR
CALL listsince()
CALL readlines('RAM:dirlist' 1)
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


listsince:
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES SINCE' sincedate
RETURN


list:
onetime=0
IF DATATYPE(arg,'W') THEN onetime=1
ELSE arg=''
DO listloop=1
  IF DATATYPE(arg,'W') THEN
    DO
      dirnum=arg
      arg=''
      IF chdir2()>0 THEN RETURN
      CALL listsimple()
      IF waitchar='Q' THEN RETURN
      IF onetime THEN LEAVE listloop
    END
  ELSE IF arg='' THEN
    DO
      IF chdir()>0 THEN RETURN
      test='Y'
      CALL showalpha2()
      arg=''
      ITERATE listloop
    END
  ELSE RETURN
END
RETURN


listsimple:
ADDRESS COMMAND 'C:list >RAM:dirlist' directory 'DATES'
IF readlines('RAM:dirlist' 1) THEN RETURN
IF lynes.0>3 THEN
  DO
    SAY pen3'Sorting...'def||lineup||CR
    linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
    lynes.1='0'
    CALL QSORT(1,lynes.0-1,lynes)
    CALL DELAY(14)
    lynes.1=linesave
  END
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
nonstop=0
IF files.0<1 THEN RETURN
lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
IF lastfilenum<1 THEN RETURN
IF arg='' THEN
  DO
    test=getinput(1 1 '['pen3'R'def']ead descriptions or ['pen3'A'def']rchive for later download. (aR) > ')
    IF test='A' THEN
      DO
        IF STORAGE()<(bbsprefs.15+100000) THEN
          DO
            SAY CR
            SAY 'Sorry! Not enough memory left for background archiving.'CR
            SAY 'Please try again in 10 minutes or so.'CR
            SAY CR
            RETURN
          END
        CALL send2log('Arc: Make_BrowseList.baud')
        CALL Make_BrowseList.baud(name)
        IF countcheck(bbspath'Numbers/LastFile' 0)>lastfilenum THEN
          IF emailonline>=0 THEN emailonline=emailonline+1
        RETURN
      END
    line='Browsing'
    test=getinput(1 1 'Browse one library only? (Ny) > ')
    IF test='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        line=line 'the' pen3||plaindir||def 'library'
      END
    ELSE line=line 'all file libraries'
    line=line 'backwards from latest file.'
    SAY line||CR
  END
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  DO lastfileloop=1
    IF lastfilenum<1 THEN RETURN
    arg=WORD(files.lastfilenum,2)
    brfilenum=lastfilenum
    IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop
    lastfilenum=lastfilenum-1
  END
ELSE IF DATATYPE(arg,'W') & files.arg~='' THEN
  DO
    brfilenum=arg
    arg=WORD(files.arg,2)
  END
ELSE
  DO
    DO i=1 TO lastfilenum+1
      IF UPPER(WORD(files.i,2))~=UPPER(arg) THEN ITERATE i
      brfilenum=i
      LEAVE i
    END
    IF i>lastfilenum THEN
      DO
        SAY 'Unable to find a file description for' pen3||arg||def'.'CR
        RETURN
      END
  END
IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
newfilesdate=DATE('S') TIME()
DO browseloop=1
  DO i=brfilenum TO 0 BY -1
    IF files.i='' THEN ITERATE i
    testdir=UPPER(WORD(files.i,1))
    IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
      DO
        IF i>lastbrowse THEN lastbrowse=i
        ITERATE i
      END
    IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
      DO
        IF i>lastbrowse THEN lastbrowse=i
        ITERATE i
      END
    LEAVE i
  END
  IF i=0 THEN brfilenum=lastbrowse
  ELSE brfilenum=i
  argname=WORD(files.brfilenum,2)
  IF argname='' THEN RETURN
  CALL setdir(libpath||WORD(files.brfilenum,1))
  arg=bbspath'FileNotes/'plaindir'/'argname
  CALL readlines(arg 1)
  IF nonstop=1 THEN brostop=1
  ELSE brostop=0
  CALL seelines(1)
  IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  CALL checktime()
  IF brostop THEN
    DO
      SAY CR
      nonstop=1
      brfilenum=brfilenum-1
    END
  ELSE
    DO
      line=''
      endtest=UPPER(RIGHT(argname,4))
      IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
        line='['pen3'C'def']ontents ['pen3'D'def']ownload'
      ELSE line='['pen3'D'def']ownload'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'E'def']dit'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'K'def']ill'
      IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
      line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
      IF endtest='.TXT' THEN line=line '['pen3'R'def']ead'
      line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
      brcom=getinput(1 0 line)
      IF DATATYPE(brcom,'W') THEN
        DO
          brfilenum=brcom+1
          IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1
          IF brfilenum<1 THEN brfilenum=1
          SAY CR
        END
      ELSE brcom=LEFT(brcom,1)
      CALL cleanline(0)
      IF brcom='Q' THEN LEAVE browseloop
      IF brcom='M' THEN
        DO
          wordnum=FIND(data.25,brfilenum)
          IF wordnum=0 THEN
            DO
              data.25=STRIP(data.25 brfilenum)
              SAY lineup||argname 'marked for next download.'CR
              SAY CR
            END
          ELSE
            DO
              data.25=STRIP(DELWORD(data.25,wordnum,1))
              SAY argname 'removed from download list.'CR
            END
        END
      IF brcom='H' | brcom='?' THEN
        DO
          SAY pen3' - HELP with the Browse Files commands -'def||CR
          SAY ' RETURN reads the next file description in line.'CR
          SAY ' 34 will display the description of file number 34, if it exists.'CR
          SAY ' C  displays the contents of an archived (arc dms lzh lha zip zoo) file.'CR
          SAY ' D  displays the download menu.'CR
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
          SAY ' E  puts this file description into the online Editor.'CR
          SAY ' K  deletes a file you uploaded. you cannot Kill others!'CR
            END
          IF level>sysoplevel THEN
          SAY ' L  move file and description to new Library and/or rename.'CR
          SAY ' M  mark/unmark the current file for the next download'CR
          SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'CR
          SAY ' R  displays file as text. - ONLY FILES THAT END IN .TXT -'CR
          SAY ' Q  returns to the main menu(s). (Quit)'CR
          SAY CR
          CALL waiting()
          IF waitchar='Q' THEN LEAVE browseloop
        END
      ELSE IF brcom='L' & level>sysoplevel THEN
        DO
          curdir=PRAGMA('D')
          IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
            DO
              newarg=getinput(0 0 'Rename' argname 'to ')
              IF newarg~='' THEN
                DO
                  IF is_here(newarg) THEN ITERATE browseloop
                  IF EXISTS(libpath||filedir'/'newarg) THEN
                    DO
                      SAY CR
                      SAY '***' newarg 'already exists!'CR
                      SAY CR
                      ITERATE browseloop
                    END
                  junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
                  IF junk='Y' THEN
                    DO
                      lynes.2=OVERLAY(newarg,lynes.2,7,25)
                      comment=WORD(STATEF(arg),8)
                      CALL DELETE(arg)
                      arg=bbspath'FileNotes/'plaindir'/'newarg
                      CALL savelines(arg)
                      IF comment~='' THEN
                        ADDRESS COMMAND 'C:FileNote' arg comment
                      mpath=libpath||plaindir
                      CALL RENAME(mpath'/'argname,mpath'/'newarg)
                      files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
                      anum=files.brfilenum.0
                      alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
                      CALL send2log('RENAME:' argname 'to' newarg 'in' plaindir)
                      argname=newarg
                      sortalphaflag=1
                      savefileflag=1
                    END
                END
            END
          mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ')
          IF mvdir~='' THEN
            DO
              IF DATATYPE(mvdir,'W') THEN
                DO
                  dirnum=mvdir
                  IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      IF chdir2()=0 THEN
                        CALL movefile(brfilenum dirs.dirnum)
                    END
                END
              ELSE
                DO
                  mvdir=STRIP(mvdir)
                  IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      DO mj=1 TO level+1
                        IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
                      END
                      IF mj<=level THEN CALL movefile(brfilenum mvdir)
                    END
                END
            END
          IF savefileflag>0 THEN CALL savefilelist()
          CALL setdir(curdir)
        END
      ELSE IF brcom='N' THEN
        DO
          brfilenum=brfilenum-1
          nonstop=1
          SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def||CR
          SAY CR
          CALL DELAY(100)
          brcom=''
        END
      ELSE IF brcom='C' THEN
        DO
          temp=STRIP(WORD(STATEF(arg),8))
          IF temp='' THEN temp=libpath||plaindir'/'argname
          CALL Contents.rexx(temp)
          IF EXISTS('RAM:CONTENTS') THEN
            DO
              CALL cleanline(1)
              CALL readlines('RAM:CONTENTS' 1)
              CALL seelines(0)
              IF waitchar~='Q' THEN CALL waiting()
              nonstop=0
            END
          ELSE SAY pen3'Not an archived file.'def||CR
        END
      ELSE IF brcom='D' THEN
        DO
          arg2=arg
          arg=argname
          CALL dload()
          arg=arg2
        END
      ELSE IF brcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              firstedit=5
              IF level>sysoplevel THEN firstedit=1
              CALL bbsED(firstedit arg)
            END
        END
      ELSE IF brcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
                DO
                  tempnum=WORD(lynes.1,2)
                  IF tempnum=lastfilenum THEN
                    DO
                      CALL DELETE(bbspath'Numbers/LastFile')
                      CALL DELAY(28)
                      lastfilenum=lastfilenum-1
                      CALL countcheck(bbspath'Numbers/LastFile' lastfilenum)
                    END
                  files.tempnum=''
                  tempnum2=files.tempnum.0
                  alpha.tempnum2='0 0' tempnum '100'
                  IF SHOW('P','BBBBS_LOCAL') THEN CALL savefilelist()
                  ELSE savefileflag=1
                  CALL DELETE(argname)
                  CALL DELETE(arg)
                  CALL send2log('Killed:' argname)
                  SAY argname pen3'has been deleted.'def||CR
                END
            END
        END
      ELSE IF brcom='R' & endtest='.TXT' THEN
        DO
          vcount=WORD(lynes.2,7)+1
          lynes.2=STRIP(DELWORD(lynes.2,7)) vcount
          edtype=''
          CALL savelines(arg)
          CALL showtext(argname)
        END
      ELSE brfilenum=brfilenum-1
    END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting()
nonstop=0
CALL savedata(0)
RETURN


movefile:
PARSE ARG fnum movdir .
fromdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
CALL MAKEDIR(libpath||movdir)
ADDRESS COMMAND 'C:COPY' libpath||fromdir'/'farg libpath||movdir
IF EXISTS(libpath||movdir'/'farg) THEN CALL DELETE(libpath||fromdir'/'farg)
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
CALL savelines(bbspath'FileNotes/'movdir'/'farg)
ndx=files.fnum.0
dnum=finddirnum(movdir)
alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
IF EXISTS(bbspath'FileNotes/'movdir'/'farg) THEN
  DO
    temp=bbspath'FileNotes/'fromdir'/'farg
    comment=WORD(STATEF(temp),8)
    CALL DELETE(temp)
    IF comment~='' THEN
      ADDRESS COMMAND 'C:FileNote' bbspath'FileNotes/'movdir'/'farg comment
  END
savefileflag=1
line='Moved:' fromdir'/'farg 'to' movdir
CALL send2log(line)
SAY line||CR
RETURN


textsearch:
PARSE ARG sfile' 'sarg
IF sarg='' THEN RETURN 0
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN 0
sarg=UPPER(sarg)
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
retflag=0
IF POS(sarg,stemp)>0 THEN retflag=1
DROP stemp
RETURN retflag


bbsSEARCH:
smenu=menu
test=UPPER(LEFT(arg,1))
IF test='F' THEN smenu='FILE'
IF test='M' THEN smenu='MSG'
IF test='U' THEN smenu='MAIN'
IF smenu='ALL' THEN
  DO
    junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
    IF junk='F' THEN smenu='FILE'
    ELSE IF junk='M' THEN smenu='MSG'
    ELSE IF junk='U' THEN smenu='MAIN'
    ELSE RETURN
  END
IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
CALL send2log('SEARCH:' smenu 'for' searcharg)
IF smenu='NEW' | smenu='MAIN' THEN
  DO
    SAY 'Searching Userlist...'CR
    DO i=1 TO WORDS(userlist)
      IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
        SAY WORD(userlist,i)||CR
    END
  END
IF smenu='MSG' THEN
  DO
    SAY 'Searching Message Conferences for'pen3 searcharg||def'...'CR
    SAY CR
    DO msgdir=1 TO level
      IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE msgdir
      CALL searchmsgdir()
      IF msgcom='Q' THEN LEAVE msgdir
    END
  END
IF smenu='FILE' THEN
  DO
    SAY pen3'WARNING!'def 'Searching' files.0 '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'CR
    test=getinput(1 1 ' ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
    IF test='Q' THEN RETURN
    IF test~='F' THEN
      DO
        SAY CR
        SAY pen3'Searching files for'def UPPER(searcharg)||CR
        CALL fileheader()
        DO i=1 TO alpha.0
          IF WORD(alpha.i,4)>level THEN ITERATE i
          ii=WORD(alpha.i,3)
          IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
          tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
          IF tempnum>0 THEN
            DO
              SAY alpha.i||CR
              IF colorflag=1 THEN
                SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def||CR
            END
        END
      END
    ELSE
      DO
        SAY CR
        SAY pen3'Searching files for'def UPPER(searcharg)||CR
        SAY pen3' - To ABORT, press CTRL-E -'def||CR
        SAY CR
        cck=countcheck(bbspath'Numbers/LastFile' 0)
        nonstop=1
        DO i=1 TO cck
          iii=cck+1-i
          IF files.iii='' THEN ITERATE i
          farg=WORD(files.iii,1)'/'WORD(files.iii,2)
          ii=files.iii.0
          IF WORD(alpha.ii,4)>level THEN ITERATE i
          IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
          SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)||CR
          IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
            DO
              savei=i
              CALL readlines(bbspath'FileNotes/'farg 1)
              CALL seelines(2)
              i=savei
              SAY CR
              SAY CR
            END
        END
      END
  END
searcharg=''
nonstop=0
CALL waiting()
RETURN


searchmsgdir:
msglist=SHOWDIR(msgpath||msgdir)
IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)||CR
DO sri=1 TO WORDS(msglist)
  messnum=WORD(msglist,sri)%1
  IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN
    DO
      savelast=lastread.msgdir
      CALL readmsg(0 messnum)
      lastread.msgdir=savelast
      IF msgcom='Q' THEN RETURN
    END
END
RETURN


finddirnum:
ARG fdirname .
DO fdir=1 TO 99
  IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
END
RETURN 100


writebuffer:
PARSE ARG bufname .
Capture OFF
CALL DELETE(bufname)
SAY 'Type 'pen3'/E'def' or 'pen3'/S'def' on a new line to Exit and Save.'CR
IF EXISTS(bufname) THEN
  DO
    CALL DELAY(56)
    CALL DELETE(bufname)
    CALL DELAY(56)
  END
CaptWrap 74
Send pen3
Capture bufname
Send def
TimeOut 120
DO bufloop=1
  Wait '/E,/S,RING,NO CARRIER'
  Status 'L'
  test=LEFT(UPPER(cleanstring(0':'RESULT)),2)
  IF test='/E' | test='/S' THEN LEAVE bufloop
  CALL checkdcd()
END
Send '\b\b'pen3
Capture OFF
CALL checkdcd()
TimeOut maxidle
SAY def||CR
startnum=lynes.0+1
CALL readlines(bufname startnum)
CALL wrapbuf(startnum)
QUEUE CR
RETURN


wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def||CR
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=cleanstring(2':'lynes.startnum)
DO wi=startnum WHILE wi<=lynes.0
  wj=wi+1
  lynes.wj=TRANSLATE(lynes.wj,' ','09'x)
  lynes.wj=cleanstring(2':'lynes.wj)
  IF LENGTH(lynes.wi)>75 THEN
    DO
      testchar=''
      IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
      IF testchar=' ' | testchar='.' | testchar=':' THEN
        DO
          DO wjj=lynes.0 TO wi+1 BY -1
            wk=wjj+1
            lynes.wk=lynes.wjj
          END
          lynes.wj=''
          lynes.0=lynes.0+1
        END
      DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
        IF WORDS(lynes.wi)=1 THEN
          lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
        lynes.wj=WORD(lynes.wi,wl) lynes.wj
        lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
      END
    END
END
RETURN


seelines:
ARG fancy .
DO i=1 TO lynes.0
  IF fancy=0 THEN SAY lynes.i||def||CR
  ELSE
    DO
      IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
      ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
        SAY pen3||lynes.i||def||CR
      ELSE SAY lynes.i||CR
      IF fancy=2 & colorflag=1 & searcharg~='' THEN
        DO
          testpos=POS(UPPER(searcharg),UPPER(lynes.i))
          IF testpos>0 THEN
            SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def||CR
        END
    END
  IF i//linesperpage=0 THEN
    IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN


readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
  line=READLN(f)
  IF EOF(f) THEN BREAK
  lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0


savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
  DO
    ok=OPEN(f,tempname,'A')
    IF ok~=0 THEN CALL WRITELN(f,INSERT('','',1,74,'^'))
  END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
  DO
    line='***' tempname 'failed to open for saving!'
    CALL send2log(line)
    SAY line||CR
    RETURN 1
  END
DO wi=1 TO lynes.0
  CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0


loaduserlist:
userlist=SHOWDIR(bbspath'Users')
ulynes.=''
IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist()
ELSE IF readopen(bbspath'Lists/USERS') THEN
  DO
    SAY 'Loading Userlist...'CR
    DO lui=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      ulynes.lui=line
    END
    ulynes.0=lui-1
    CALL CLOSE(f)
  END
RETURN


saveuserlist:
SIGNAL OFF BREAK_E
IF writeopen(bbspath'Lists/USERS') THEN
  DO
    DO i=1 TO ulynes.0
      CALL WRITELN(f,ulynes.i)
    END
    CALL CLOSE(f)
  END
RETURN


sortuserlist:
SAY 'Rebuilding Userlist...'CR
sortuserflag=0
userlist=SHOWDIR(bbspath'Users')
user.=''
users=WORDS(userlist)
user.0=users
DO uli=1 TO users
  user.uli=WORD(userlist,uli)
  uscore=LASTPOS('_',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
END
CALL QSORT(1,users,user)
DO uli=1 TO users
  uscore=POS('@',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
END
ulynes.=''
ulynes.0=user.0%3
IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
DO i=1 TO ulynes.0
  ulynes.i=LEFT(user.i,25)
  DO j=1 TO 2
    k=i+j*ulynes.0
    IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
  END
END
CALL saveuserlist()
RETURN


showuserlist:
IF data.5='' THEN line='Here are the EMail names of your fellow users.'
ELSE line='   'WORDS(userlist) 'users. Use these names to address messages.'
SAY pen3||line||def||CR
DO uli=1 TO ulynes.0
  SAY ulynes.uli||CR
  IF uli//linesperpage=0 & uli<ulynes.0 THEN
    IF waiting2()=1 THEN RETURN
END
IF data.5~='' THEN CALL waiting()
RETURN


msgcount:
ARG countdir .
lastmess=0
totmsgs=0
unred=0
IF ~EXISTS(msgpath||countdir) THEN RETURN
IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
ELSE
  DO
    totmsgs=WORDS(SHOWDIR(msgpath||countdir))
    msg.countdir.0=totmsgs
    msg.countdir.1=STATEF(msgpath||countdir)
  END
IF countdir>level | FIND(data.21,i)>0 THEN RETURN
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
IF lastread.countdir<0 THEN RETURN
firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF lastmess>0 THEN
  IF lastread.countdir>=0 THEN
    DO
      IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
      unred=lastmess-lastread.countdir
      IF unred>totmsgs THEN unred=totmsgs
      cline=RIGHT(unred,6) 'unread of' RIGHT(lastmess,6)
      cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.'
      IF unred>0 | ~logonflag THEN SAY pen6||cline||def||CR
    END
RETURN


counts:
SAY CR
SAY 'Working...'CR
SAY CR
temp=''
DO i=1 TO 4
  temp=temp||CENTER(copyright.i,75)||'0D0A'x
END
CALL SETCLIP('BBS_copyright',temp||CR)
CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0)
SAY CR
CALL waiting2()
IF waitchar='Q' THEN RETURN
CALL showmarked()
CALL logonstats()
nonstop=0
CALL waiting()
RETURN


countmail:
SAY '   Counting online email...'lineup||CR
emailonline=0
DO ti=1 TO WORDS(userlist)
  emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti)))
END
RETURN


hourly:
IF level=99 & nonstop~=1 THEN
  DO
    IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
      ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
    CALL cleanline(1)
  END
CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
RETURN


logonstats:
IF level=0 THEN RETURN
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime||CR
tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
line='of' RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'public files uploaded.'CR
IF tempnum>0 THEN SAY RIGHT(tempnum,6) '   new of' RIGHT(files.0,6) 'files online    'line
ELSE SAY '       No new' line
totmsg=0
grand=0
grand2=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  CALL msgcount(i)
  totmsg=totmsg+unred
  grand=grand+totmsgs
  grand2=grand2+lastmess
END
line=RIGHT(grand2,6) 'public messages written'
IF totmsg>0 THEN
  SAY RIGHT(totmsg,6) '   new of' line',' grand 'messages still online.'CR
ELSE SAY '       No new of' line'.'CR

callsleft:
test=WORD(data.11,3)
IF test<1 THEN
  line=pen0||bak1' Attention! 'def 'This is your last call for' DATE('W')',' DATE()
ELSE
  DO
    line='You may call' test 'more time'
    IF test~=1 THEN line=line's'
    line=line 'today.'
  END
SAY line||CR
RETURN


checkdcd:
IF GETCLIP('BBS_interpret')='' THEN
  DO
    dcd
    IF RC=0 THEN
      DO
        DO dcds=1 TO 3  /* 5 second delay */
          CALL DELAY(50)
          dcd
          IF RC~=0 THEN RETURN
        END
        dcd
        IF RC=0 THEN
          DO
            SAY CR
            Capture OFF
            Remote OFF
            CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
            line='^^^^^ LOST CARRIER! ^^^' DATE() TIME() '^^^^^'
            SAY line||CR
            Send '\dATH1\r'
            CALL send2log(line)
            CALL sound('ALERT')
            IF newpassword='' THEN SIGNAL DONE
            ELSE SIGNAL OUT
          END
      END
  END
CALL checkexternal()
RETURN


sound:
ARG snd
IF bbsprefs.13=1 THEN RETURN
sndfile=bbspath'Sounds/'snd
IF ~EXISTS(WORD(sndfile,1)) THEN RETURN
ADDRESS COMMAND 'c:run >nil: c:sound' sndfile
RETURN


checkexternal:
xmsg=GETCLIP('BBS_MESSAGE')
Capture
IF RC=0 & xmsg~='' THEN
  DO
    SAY CR
    SAY bak2' Message From BBBBS: 'def||CR
    SAY xmsg||CR
    SAY CR
    CALL SETCLIP('BBS_MESSAGE')
  END
xstring=GETCLIP('BBS_interpret')
IF xstring~='' THEN
  DO
    INTERPRET xstring
    CALL SETCLIP('BBS_interpret')
  END
xcom=GETCLIP('BBS_COMMAND')
IF xcom~='' THEN
  DO
    CALL SETCLIP('BBS_COMMAND')
    IF POS('G',xcom)>0 THEN SIGNAL LOGOUT2
    IF opt~='' THEN
      DO
        IF POS('M',xcom)>0 THEN CALL validate()
        IF POS('L',xcom)>0 THEN CALL uplevel()
        IF POS('T',xcom)>0 THEN CALL uptime()
        IF POS('R',xcom)>0 THEN CALL upratio()
      END
    IF POS('C',xcom)>0 THEN CALL chat()
  END
RETURN


chat:
chatrequest=0
chattime=TIME('E')
SAY 'Entering chat mode with sysop.'CR
MSG pen3'- Press backslash [\] to exit -'def
SAY 'Press [RETURN] twice to tell' sysop 'you are finished typing.'CR
SAY CR
OPTIONS PROMPT ''
string=''
DO WHILE(string~='\')
  PULL string
  CALL checkdcd()
END
maxtime=maxtime+(TIME('E')-chattime)%1
RETURN


readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line||CR
CALL send2log(line)
RETURN 0


writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for writing!'
SAY line||CR
CALL send2log(line)
RETURN 0


set_grand:
SAY 'Setting up public message conferences...'CR
grand=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
  msg.i.1=STATEF(msgpath||i)
  grand=grand+msg.i.0
END
RETURN


checkstats:          /* clip is set and cleared by stats programs */
IF TIME('H')>3 & GETCLIP('BBS_STAT')='' THEN
  DO
    IF EXISTS(bbspath'Information/STATS.ULDL') THEN
      DO
        lfinfo=STATEF(bbspath'Information/STATS.ULDL')
        IF WORD(lfinfo,5)<DATE('I') THEN
          DO
            ADDRESS AREXX bbsULDL.rexx
            CALL DELAY(100)
          END
      END
    IF TIME('H')>4 & GETCLIP('BBS_STAT')='' & EXISTS(bbspath'Information/STATS.USER') THEN
      DO
        ufinfo=STATEF(bbspath'Information/STATS.USER')
        IF WORD(ufinfo,5)<DATE('I') THEN
          DO
            ADDRESS AREXX bbsUSER.rexx
            CALL DELAY(100)
          END
      END
    IF grand>SYSTEM_MSG_LIMIT & TIME('H')>5 & TIME('H')<9 & GETCLIP('BBS_STAT')='' THEN
      DO
        SAY 'Doing Message Conference Maintenence...'CR
        Send 'ATH1\r'
        CALL bbsMAINT.baud(SYSTEM_MSG_LIMIT sysop)
        CALL set_grand()
        Send 'ATZ\r'
      END
  END
RETURN


zerovars:
lastread.=0
totwrit.=0
data.=''
libs.=''
smsg.=''
msgs.=''
sdirs.=''
pasted.=''
pasted.0=0
clear_marked=0
sortalphaflag=0
savefileflag=0
sortuserflag=0
linesperpage=22
chatrequest=0
lastbrowse=0
buildalpha=0
terseflag=0
warnings=0
winnings=0
menuflag=0
nonstop=0
dirnum=1
msgdir=1
level=0
newfilesflag=0
newfilesdate=''
newpassword=''
replymsg=''
waitchar=''
string=''
name=''
city='?'
opt=''
RETURN


HALT:
SYNTAX:
FAILURE:
lin.1=pen7||ERRORTEXT(RC)||def
lin.2=SIGL-1     SOURCELINE(SIGL-1)
lin.3=SIGL pen7||SOURCELINE(SIGL)||def
lin.4=SIGL+1     SOURCELINE(SIGL+1)
DO er=1 TO 4
  IF level>sysoplevel THEN SAY lin.er||CR
  CALL send2log(lin.er)
END
CALL CLOSE(f)
IF newpassword='' THEN SIGNAL DONE  /* no user logged on, quit quietly */
SAY CR
CALL checkdcd()
IF level>sysoplevel THEN
  DO
    junk=getinput(1 1 'ReStart: (Ny) > ')
    IF junk~='Y' THEN SIGNAL LOGOUT
  END
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
SIGNAL RESTART


BREAK_E:
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def||CR
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
wi=999999
ni=0
QUEUE CR
RETURN 0


BREAK_C:
SIGNAL OFF BREAK_C
SIGNAL OFF BREAK_E
CALL CLOSE(f)
IF newpassword='' THEN
  DO
    CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
    SIGNAL DONE  /* no user logged on, quit quietly */
  END
CALL checkdcd()
SAY CR
IF warnings<1 THEN  /* just 1 warning */
  DO
    warnings=warnings+1
    SAY CR
    SAY 'If you didn''t press CTRL-C then...   HEY!    Wake up!'CR
    SAY '                                     Auto-disconnect in' TRUNC(maxidle/60+.5) 'minutes!'CR
    SAY CR
    SAY 'If you DID press CTRL-C,  PLEASE  use CTRL-E next time instead.'CR
    SAY CR
    Remote OFF
    Send '^G\w^G\w^G^G^G^G'
    Remote ON
    waitchar=''
    string=''
    nonstop=0
    SIGNAL RESTART
  END
CALL SETCLIP('BBS_disconnect',TIME('C') DATE() name)
SAY 'No Activity For' TRUNC(maxidle/30+.5) 'minutes! -- Disconnecting.'CR
Send '\d'
CALL sound('ALERT 2')
SIGNAL OUT

LOGOUT:
junk=getinput(1 1 pen3'Leave Feedback for SysOp? (Ny) > 'def)
IF junk='Y' THEN
  DO
    opt='C'  /* to trigger Feedback as Subject */
    CALL editor('MAIL' sysop)
  END

LOGOUT2:
CALL checkexternal()
SIGNAL OFF BREAK_E
CALL SETCLIP('BBS_level')
CALL callsleft()
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY
SAY 'Public  files   online: 'RIGHT(comma(files.0),9)||CR
SAY 'Public messages online: 'RIGHT(comma(grand),9)||CR
SAY CR
SAY 'Time used this call:' mins':'secs||CR
CALL bbsLOGOFF.baud(name level mins secs)
SAY 'Goodbye' name', thank you for calling' bbsname'.'CR
linesperpage=99
arg=bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
  DO
    CALL DELAY(14)
    CALL readlines(arg 1)
    CALL seelines(0)
  END
SAY CR
IF bbsprefs.2 & ~terseflag THEN CALL doGrin()

OUT:
SIGNAL OFF BREAK_E
Remote OFF
data.18=winnings
line=left(name,16,' ') 'logged off at' time('C')
dcd
IF RC~=0 THEN Send '\ah'
IF data.20~='' THEN
  DO
    Status 'Y'
    elapsed=RESULT
    line=line 'Total:'elapsed
    PARSE VAR elapsed thour':'tmin':'.
    ADDRESS AREXX bbsHOURLY.rexx TIME('H') TIME('M')//60 thour tmin bbspath'Numbers/Hourly'
    PARSE VAR data.19 dhour 'hours' dmin 'minutes in' calls .
    IF ~DATATYPE(tmin,'W')  THEN tmin=0
    IF ~DATATYPE(thour,'W') THEN thour=0
    IF ~DATATYPE(dhour,'W') THEN dhour=0
    IF ~DATATYPE(dmin,'W')  THEN dmin=0
    IF ~DATATYPE(calls,'W') THEN calls=0
    IF thour=0 & tmin<3 THEN  /* free call if less than 3 minutes */
      DO
        wordloc=WORDINDEX(data.11,3)-1
        wordval=WORD(data.11,3)+1
        data.11=DELWORD(data.11,3,1)
        data.11=INSERT(wordval' ',data.11,wordloc)
      END
    ufile=LEFT(DATE('S'),6)
    mmins=thour*60+tmin+countcheck(bbspath'Usage/'ufile 0)
    mins=thour*60+tmin+countcheck(bbspath'Numbers/Minutes' 0)
    cals=countcheck(bbspath'Numbers/Calls' 0)+1
    CALL countcheck(bbspath'Numbers/Minutes' mins)
    CALL countcheck(bbspath'Numbers/Calls' cals)
    CALL countcheck(bbspath'Usage/'ufile mmins)
    thour=thour+dhour
    tmin=tmin+dmin+1
    IF tmin>59 THEN
      DO
        thour=thour+tmin%60
        tmin=tmin//60
      END
    data.19=thour 'hours' tmin 'minutes in' calls+1 'calls.'
    CALL SETCLIP('BBS_totalusage',mmins%60 mmins//60)
    CALL SETCLIP('BBS_userlogoff',TIME('C') DATE())
    CALL postuser(6)
    IF newfilesflag=1 THEN
      DO
        newfilesdate=DATE('S') TIME()
        lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
      END
    IF clear_marked=1 THEN data.24=''
    CALL saveData(1)
    data.5=''
    IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
      ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
    arg=''
    lastline=RIGHT(TIME('C'),7) LEFT(DATE(),6)
    lastline=lastline'  'RIGHT(city,40)
    lastline=OVERLAY(name,lastline,16,LENGTH(name)+1) RIGHT(bps,5)
    lastline=lastline' Time:'elapsed
    newpassword=''
    CALL send2last(lastline)
    CALL sound('LOGOFF')
    SAY lastline||CR
    CALL bbsLOGOFF.baud(name level elapsed)
  END

OUT2:
CALL send2log(line)

DONE:
CALL send2log('')
logonflag=0

DONE2:
CALL setdir(libpath||dirs.1)
CALL SETCLIP('BBS_winnings')
CALL SETCLIP('BBS_minutes')
CALL SETCLIP('BBS_door_demon')
CALL SETCLIP('BBS_level')
IF SHOW('P','BBS_DOOR_DEMON') THEN CALL SETCLIP('BBS_door_demon','QUIT')
Capture
IF RC~=0 THEN Capture OFF
Send '\c\ah'
CALL DELAY(14)
Remote OFF
baud maxbps
IF sortuserflag=0 & sortalphaflag=0 & savefileflag=0 & emailonline>=0 & buildalpha=0 THEN
  CALL DELAY(100)
ELSE
  DO
    Send 'ATH1\r'
    CALL DELAY(128)
    Send 'ATH1\r'
  END
IF buildalpha~=0 THEN
  DO
    CALL BuildALPHA.rexx()
    sortalphaflag=0
    savefileflag=0
    buildalpha=0
  END
IF sortuserflag=1 THEN
  DO
    CALL sortuserlist()
    IF SHOW('P','BBBBS_LOCAL') THEN
      DO
        CALL SETCLIP('BBS_localusers')
        CALL SETCLIP('BBS_mainusers',1)
      END
  END
IF sortalphaflag>0 | savefileflag>0 THEN
  DO
    IF savefileflag>0 THEN CALL savefilelist2()
    ELSE CALL savealphalist()
    IF SHOW('P','BBBBS_LOCAL') THEN CALL SETCLIP('BBS_mainfiles',2)
  END
IF emailonline<0 THEN CALL countmail()
bad_atz=ATZreset()   /* reset modem */
IF bbsprefs.15=0 THEN  /* quit or restart? */
  DO
    CALL checkstats()
    EXIT
  END
IF STORAGE()<bbsprefs.15 THEN
  DO
    SAY CR
    SAY '*** Unsafe memory level!'CR
    line='*** Less than' bbsprefs.15 'bytes available, BBBBS has been unloaded.'
    SAY line||CR
    SAY CR
    CALL send2log(line)
    EXIT
  END
CALL CLOSE(f)
CALL CLOSE('log')
CALL zerovars()
DO FOREVER
  IF GETCLIP('BBS_QUIT')='QUIT' THEN
    DO
      CALL SETCLIP('BBS_QUIT')
      CALL SETCLIP('BBS_maint')
      CALL SETCLIP('BBS_localfiles')
      CALL SETCLIP('BBS_localusers')
      Send '\c'
      EXIT
    END
  xstring=GETCLIP('BBS_interpret')
  IF xstring~='' THEN
    DO
      INTERPRET xstring
      CALL SETCLIP('BBS_interpret')
      SIGNAL DONE2
    END
  IF bad_atz=1 THEN bad_atz=ATZreset()
  IF GETCLIP('BBS_localfiles')>1 & GETCLIP('BBS_maint')='' THEN
    DO
      CALL DELAY(150)
      Send 'ATH1\r'
      CALL SETCLIP('BBS_localfiles')
      CALL loadfiles()
      CALL loadalpha()
      SIGNAL DONE2
    END
  IF GETCLIP('BBS_localusers')~='' THEN
    DO
      CALL DELAY(150)
      Send 'ATH1\r'
      CALL SETCLIP('BBS_localusers')
      CALL loaduserlist()
      SIGNAL DONE2
    END
  dcd
  IF RC~=0 THEN Send '\ah'
  wres=''
  Wait 'RING'
  wres=RESULT
  IF wres='RING' THEN
    DO
      Send 'ATA\r'
      Timeout 45
      wres=''
      Wait 'CONNECT,NO CARRIER,RING,+FCON,+FHNG' /* wait 45 seconds for connect */
      wres=RESULT
      IF wres~='CONNECT' THEN SIGNAL DONE2
      CALL DELAY(114)
      SAY ' 'CR
      CALL DELAY(28)
      SAY ' 'CR
      dcd
      IF RC=0 THEN
        DO
          CALL DELAY(128)
          dcd
          IF RC=0 THEN
            DO
              CALL DELAY(128)
              dcd
              IF RC=0 THEN SIGNAL DONE2
            END
        END
      IF GETCLIP('BBS_maint')='' THEN
        DO
          CALL SETCLIP('BBS_interpret')
          CALL DELAY(114)
          SIGNAL LOGON
        END
      Remote ON
      SAY bbsname 'is busy with periodic maintenance.'CR
      SAY 'Please try again in a few minutes.'CR
      Send '\ah'
      SIGNAL DONE2
    END
  ELSE CALL checkstats()
END
EXIT



ATZreset:
TimeOut 10
Send 'ATZ\r'
Wait 'OK,RING'
IF RESULT~='OK' THEN
  DO
    Send '\d\wATZ\r'
    Wait 'OK'
    IF RESULT~='OK' THEN
      DO
        Send '\w\w+++\w\w\w\wATH\r'
        CALL sound('ALERT 3')
        line='*** ATZ failed to reset!' TIME('C') DATE()
        SAY line'  Check your modem!!'CR
        CALL send2log(line)
        RETURN 1
      END
  END
TimeOut 45
Send '\dATH\r'
RETURN 0


getbaudrate: PROCEDURE
TRACE OFF
BaudRate
brate=RC
TRACE
RETURN brate


/* BBBBS.baud */